testing CI

.github/workflows/PRformat.yml

@@ -4,6 +4,7 @@ on:
   pull_request:
     branches:
       - 'master'
+      - 'test-fix' #debug
 
 env:
   OPAMROOT: /home/user/.opam
@@ -35,15 +36,16 @@ jobs:
       ############# Detecting and compiling fp2024
       # Smart link about setting environment variables
       # https://docs.github.com/en/actions/reference/workflow-commands-for-github-actions#setting-an-environment-variable
-      - name: Detect latest changes
-        run: |
-          opam exec -- ocaml .github/detect_latest_pr.ml -v "pull/${{ steps.branch-name.outputs.ref_branch }}" -repo ${{ github.event.repository.name }} >> $GITHUB_ENV
-          echo "${{ env.latest }}"
+# DEBUG TO UNCOMMENT BEFORE PR
+#      - name: Detect latest changes
+#        run: |
+#          opam exec -- ocaml .github/detect_latest_pr.ml -v "pull/${{ steps.branch-name.outputs.ref_branch }}" -repo ${{ github.event.repository.name }} >> $GITHUB_ENV
+#          echo "${{ env.latest }}"
 
       - name: Naive linting
         run: |
           cd ${{ env.latest }}
-          python ../.github/lint_filesystem.py ${{ env.latest }}
+          find . -type l -name 'manytests' -prune -o -type f -exec python ../.github/lint_filesystem.py {} \;
 
 #      - name: Checking ocamlformat
 #        id: check-ocamlformat
@@ -59,7 +61,8 @@ jobs:
       - name: Checking ocamlformat
         run: |
           cd ${{ env.latest }}
-          opam exec -- dune build @fmt --profile=release
+          find . -type l -name 'manytests' -prune -o -type f -exec opam exec -- dune build @fmt --profile=release {} \;
+
 
 
       # TODO: onfail post a comment how to fix it

FSharpActivePatterns/bin/REPL.ml

@@ -4,16 +4,19 @@
 
 open FSharpActivePatterns.AstPrinter
 open FSharpActivePatterns.Parser
+open FSharpActivePatterns.Inferencer
+open FSharpActivePatterns.TypedTree
+open FSharpActivePatterns.TypesPp
+open FSharpActivePatterns.Ast
 open FSharpActivePatterns.PrettyPrinter
 open Stdlib
 
 type input =
   | Input of string
   | EOF
 
-type 'a run_result =
-  | Result of 'a
-  | Fail
+type run_result =
+  | Result of (construction, string) result
   | Empty
   | End
 
@@ -41,44 +44,93 @@ let input_upto_sep sep ic =
   fill_buffer buffer
 ;;
 
+let input_with_indents ic =
+  let take_line () = In_channel.input_line ic in
+  let rec fill_buffer b =
+    let start_pos = pos_in ic in
+    let line = take_line () in
+    match line with
+    | None -> Input (Buffer.contents b)
+    | Some line ->
+      let is_empty = String.length line = 0 in
+      let is_continue =
+        List.exists (fun pref -> String.starts_with ~prefix:pref line) [ " "; "\t"; "\n" ]
+        || is_empty
+        || String.starts_with ~prefix:"and" (String.trim line)
+      in
+      (match is_continue with
+       | true ->
+        let newline = " " ^ line in
+         Buffer.add_string b newline;
+         Buffer.add_string b "\n";
+         fill_buffer b
+       | false ->
+         seek_in ic start_pos;
+         Buffer.add_string b "\n";
+         Input (Buffer.contents b))
+  in
+  let buffer = Buffer.create 1024 in
+  let first_line = take_line () in
+  match first_line with
+  | None ->
+    EOF
+  | Some first_line ->
+    Buffer.add_string buffer first_line;
+    fill_buffer buffer
+;;
+
 let run_single ic =
-  match input_upto_sep ";;" ic with
+  let input =
+    match ic with
+    | None -> input_upto_sep ";;" stdin
+    | Some ic -> input_with_indents ic
+  in
+  match input with
   | EOF -> End
   | Input input ->
     let trimmed_input = String.trim input in
-    if trimmed_input = ""
-    then Empty
-    else (
-      match parse trimmed_input with
-      | Some ast -> Result ast
-      | None -> Fail)
+    if trimmed_input = "" then Empty else Result (parse trimmed_input)
 ;;
 
 let run_repl dump_parsetree input_file =
   let ic =
     match input_file with
-    | None -> stdin
-    | Some n -> open_in n
+    | None -> None
+    | Some n -> Some (open_in n)
   in
-  let rec run_repl_helper run =
+  let rec run_repl_helper run env state =
     let open Format in
     match run ic with
-    | Fail -> fprintf err_formatter "Error occured\n"
+    | Result (Error e) -> fprintf err_formatter "%s\n" e
     | Empty ->
       fprintf std_formatter "\n";
       print_flush ();
-      run_repl_helper run
+      run_repl_helper run env state
     | End -> ()
-    | Result ast ->
+    | Result (Ok ast) ->
       (match dump_parsetree with
        | true -> print_construction std_formatter ast
        | false ->
-         fprintf std_formatter "- : ";
-         pp_construction std_formatter ast);
-      print_flush ();
-      run_repl_helper run
+         let result = infer ast env state in
+         (match result with
+          | new_state, Error err ->
+            fprintf err_formatter "Type checking failed: %a\n" pp_error err;
+            print_flush ();
+            run_repl_helper run env new_state
+          | new_state, Ok (env, names_and_types) ->
+            List.iter
+              (fun (n, t) -> fprintf std_formatter "%s : %a" n pp_typ t)
+              names_and_types;
+            print_flush ();
+            run_repl_helper run env new_state))
+  in
+  let env =
+    TypeEnvironment.extend
+      TypeEnvironment.empty
+      "print_int"
+      (Scheme (VarSet.empty, Arrow (int_typ, unit_typ)))
   in
-  run_repl_helper run_single
+  run_repl_helper run_single env 0
 ;;
 
 type opts =

FSharpActivePatterns/bin/dune

@@ -1,6 +1,6 @@
 (executable
  (public_name repl)
  (name REPL)
- (libraries FSharpActivePatterns stdlib)
+ (libraries FSharpActivePatterns stdlib str)
  (instrumentation
   (backend bisect_ppx)))

FSharpActivePatterns/bin/input.txt

@@ -1,7 +1,41 @@
-let rec even n = 
-    if n = 0 then true 
-    else odd (n - 1)
-and odd n : int = 
-    if n = 0 then false 
-    else even (n - 1)
-;;
+let rec length xs =
+  match xs with
+  | [] -> 0
+  | h::tl -> 1 + length tl
+
+let length_tail =
+  let rec helper acc xs =
+  match xs with
+  | [] -> acc
+  | h::tl -> helper (acc + 1) tl
+  in
+  helper 0
+
+let rec map f xs =
+  match xs with
+  | [] -> []
+  | a::[] -> [f a]
+  | a::b::[] -> [f a; f b]
+  | a::b::c::[] -> [f a; f b; f c]
+  | a::b::c::d::tl -> f a :: f b :: f c :: f d :: map f tl
+
+let rec append xs ys = match xs with [] -> ys | x::xs -> x::(append xs ys)
+
+let concat =
+  let rec helper xs =
+    match xs with
+    | [] -> []
+    | h::tl -> append h (helper tl)
+  in helper
+
+let rec iter f xs = match xs with [] -> () | h::tl -> let () = f h in iter f tl
+
+let rec cartesian xs ys =
+  match xs with
+  | [] -> []
+  | h::tl -> append (map (fun a -> (h,a)) ys) (cartesian tl ys)
+
+let main =
+  let () = iter print_int [1;2;3] in
+  let () = print_int (length (cartesian [1;2] [1;2;3;4])) in
+  0

FSharpActivePatterns/lib/ast.ml

@@ -3,9 +3,9 @@
 (** SPDX-License-Identifier: LGPL-3.0-or-later *)
 
 open KeywordChecker
+open TypedTree
 
-type ident = Ident of string * string option (** identifier *)
-[@@deriving show { with_path = false }]
+type ident = Ident of string (** identifier *) [@@deriving show { with_path = false }]
 
 let gen_varname =
   let open QCheck.Gen in
@@ -26,8 +26,8 @@ let gen_varname =
   loop >>= fun name -> if is_keyword name then loop else return name
 ;;
 
-let gen_ident = QCheck.Gen.map (fun s -> Ident (s, None)) gen_varname
-let gen_ident_small_list = QCheck.Gen.(list_size (0 -- 3) gen_ident)
+let gen_ident = QCheck.Gen.map (fun s -> Ident s) gen_varname
+(* let gen_ident_small_list = QCheck.Gen.(list_size (0 -- 3) gen_ident) *)
 
 let gen_escape_sequence =
   let open QCheck.Gen in
@@ -98,15 +98,21 @@ type pattern =
   | PConst of literal (** | [4] -> *)
   | PVar of ident (** pattern identifier *)
   | POption of pattern option
-    (*| Variant of (ident list[@gen gen_ident_small_list]) (** | [Blue, Green, Yellow] -> *) *)
+  (*| Variant of (ident list[@gen gen_ident_small_list]) (** | [Blue, Green, Yellow] -> *) *)
+  | PConstraint of pattern * (typ[@gen gen_typ_sized (n / 4)])
 [@@deriving show { with_path = false }, qcheck]
 
+let gen_typed_pattern_sized n = QCheck.Gen.(pair (gen_pattern_sized n) (return None))
+
 type is_recursive =
   | Nonrec (** let factorial n = ... *)
   | Rec (** let rec factorial n = ... *)
 [@@deriving show { with_path = false }, qcheck]
 
-type expr =
+type case = (pattern[@gen gen_pattern_sized n]) * (expr[@gen gen_expr_sized n])
+[@@deriving show { with_path = false }, qcheck]
+
+and expr =
   | Const of literal (** [Int], [Bool], [String], [Unit], [Null] *)
   | Tuple of
       (expr[@gen gen_expr_sized (n / 4)])
@@ -129,29 +135,30 @@ type expr =
       * expr (** fun x y -> x + y *)
   | Apply of (expr[@gen gen_expr_sized (n / 4)]) * (expr[@gen gen_expr_sized (n / 4)])
   (** [sum 1 ] *)
+  | Function of
+      (case[@gen gen_case_sized (n / 4)])
+      * (case list[@gen QCheck.Gen.(list_size (0 -- 2) (gen_case_sized (n / 20)))])
+  (** [function | p1 -> e1 | p2 -> e2 | ... |]*)
   | Match of
       (expr[@gen gen_expr_sized (n / 4)])
-      * (pattern[@gen gen_pattern_sized (n / 4)])
-      * (expr[@gen gen_expr_sized (n / 4)])
-      * ((pattern * expr) list
-        [@gen
-          QCheck.Gen.(
-            list_size
-              (0 -- 2)
-              (pair (gen_pattern_sized (n / 20)) (gen_expr_sized (n / 20))))])
-  (** [match x with | x -> ... | y -> ...] *)
+      * (case[@gen gen_case_sized (n / 4)])
+      * (case list[@gen QCheck.Gen.(list_size (0 -- 2) (gen_case_sized (n / 20)))])
+  (** [match x with | p1 -> e1 | p2 -> e2 | ...] *)
   | LetIn of
       is_recursive
       * let_bind
       * (let_bind list
         [@gen QCheck.Gen.(list_size (0 -- 2) (gen_let_bind_sized (n / 20)))])
       * expr (** [let rec f x = if (x <= 0) then x else g x and g x = f (x-2) in f 3] *)
   | Option of expr option (** [int option] *)
+  | EConstraint of expr * (typ[@gen gen_typ_sized (n / 4)])
 [@@deriving show { with_path = false }, qcheck]
 
 and let_bind =
-  | Let_bind of ident * (ident list[@gen gen_ident_small_list]) * expr
-  (** [and sum n m = n+m] *)
+  | Let_bind of
+      (pattern[@gen gen_pattern_sized (n / 2)])
+      * (pattern list[@gen QCheck.Gen.(list_size (0 -- 3) (gen_pattern_sized (n / 4)))])
+      * expr (** [let sum n m = n + m] *)
 [@@deriving show { with_path = false }, qcheck]
 
 let gen_expr =