From 3dc4a1068c882f07e2e433ebb5a61c6efbd59449 Mon Sep 17 00:00:00 2001
From: Mylloon <kennel.anri@tutanota.com>
Date: Tue, 17 Oct 2023 16:49:43 +0200
Subject: [PATCH] some definitions added

---
 flap/src/hopix/hopixLexer.mll  |  8 +++-
 flap/src/hopix/hopixParser.mly | 73 +++++++++++++++++++++++-----------
 2 files changed, 56 insertions(+), 25 deletions(-)

diff --git a/flap/src/hopix/hopixLexer.mll b/flap/src/hopix/hopixLexer.mll
index 59d6481..ecabc91 100644
--- a/flap/src/hopix/hopixLexer.mll
+++ b/flap/src/hopix/hopixLexer.mll
@@ -76,16 +76,20 @@ rule token = parse
   | ')'                { RPAREN   }
   | '['                { LBRACK   }
   | ']'                { RBRACK   }
+  | '{'                { LBRACE   }
+  | '}'                { RBRACE   }
   | '_'                { WILDCARD }
   | ':'                { DPOINT   }
   | "->"               { ARROW    }
-  | "<"                { INFERIOR }
-  | ">"                { SUPERIOR }
+  | '<'                { INFERIOR }
+  | '>'                { SUPERIOR }
+  | '|'                { PIPE     }
 
   (** Values *)
   | int as i           { INT (Mint.of_string i) }
   | ident as s         { ID s                   }
   | type_variable as s { TID s                  }
+  | constr_id as s     { CID s                  }
 
   (** Lexing error *)
   | _                  { error lexbuf "unexpected character." }
diff --git a/flap/src/hopix/hopixParser.mly b/flap/src/hopix/hopixParser.mly
index 7f762be..81c0678 100644
--- a/flap/src/hopix/hopixParser.mly
+++ b/flap/src/hopix/hopixParser.mly
@@ -1,58 +1,80 @@
 %{ (* -*- tuareg -*- *)
 
   open HopixAST
-  open Position
+  (* open Position *)
 
 %}
 
-%token EOF LET TYPE WILDCARD STAR INFERIOR SUPERIOR ARROW DPOINT EXTERN FUN MATCH COMMA IF THEN ELSE REF AND WHILE DO UNTIL FOR FROM TO BINOP EQUAL LPAREN RPAREN LBRACK RBRACK
+/* Opérateurs à ajouter au fur et a mesure (pour réduire les warnings temporairement) :
+ * BINOP DO ELSE FOR FROM IF INFERIOR MATCH PIPE REF SUPERIOR THEN TO UNTIL WHILE */
+%token EOF LET TYPE WILDCARD STAR ARROW DPOINT EXTERN FUN COMMA AND EQUAL LPAREN
+%token RPAREN LBRACK RBRACK LBRACE RBRACE
 
 %token<Mint.t> INT
-%token<string> ID TID
+%token<string> ID TID CID
 
 %start<HopixAST.t> program
 
 %%
 
 program:
+/* Programme */
 | definition=located(definition)* EOF {
     definition
   }
 
 
 definition:
+/* Définition de types */
+// Manque le 'type_variable located list' ici, on met une liste vide en attendant
+| TYPE tc=located(type_constructor) EQUAL td=tdefinition {
+    DefineType (tc, [], td)
+  }
+/* Valeurs externes */
+| EXTERN id=located(identifier) ts=located(type_scheme) {
+    DeclareExtern(id, ts)
+  }
+/* Définition de valeurs */
 | v=vdefinition {
     DefineValue v
   }
 
+tdefinition:
+/* Type sommes */
+/* | option(PIPE) type_constructor option() separated_nonempty_list(COMMA, ty) {
+    DefineSumType()
+  } */
+/* Type produit étiqueté */
+| LBRACE lt=separated_nonempty_list(COMMA, label_with_type) RBRACE {
+    DefineRecordType(lt)
+  }
+
+label_with_type:
+| l=located(label) DPOINT t=located(ty) { l, t }
+
 
 vdefinition:
-// manque le type ici, on met None en attendant
-| LET i=located(identifier) EQUAL e=located(expression) {
-    SimpleValue(i, None, e)
+/* Valeur simple */
+// Manque le type ici, on met None en attendant
+| LET i=located(identifier) DPOINT ts=option(located(type_scheme)) EQUAL e=located(expression) {
+    SimpleValue(i, ts, e)
   }
-/* // marche pas
-| LET i=located(identifier) DPOINT ts=located(type_scheme) EQUAL e=located(expression) {
-      SimpleValue(i,ts,e)
-  } */
-/* fun : int f a = 1 */
-| FUN f=fundef  {
-      RecFunctions([f])
+/* Fonction(s)
+ * Exemple :
+ * - fun : int f a = 1
+ * - fun f a = 1 and : int g a = 2 */
+| FUN fs=separated_nonempty_list(AND, fundef)  {
+      RecFunctions(fs)
   }
 
-
-/* de même */
 fundef:
-/* ts est temp */
-| i=located(identifier) p=pattern EQUAL e=located(expression) {
-    FunctionDefinition(p, e)
+| DPOINT t=option(located(type_scheme)) i=located(identifier) p=located(pattern) EQUAL e=located(expression) {
+    i, t, FunctionDefinition(p, e)
   }
-/* ts est temp */
-| DPOINT ts=located(type_scheme) i=located(identifier) p=located(pattern) EQUAL e=located(expression) {
-    FunctionDefinition(p, e)
+| i=located(identifier) p=located(pattern) EQUAL e=located(expression) {
+    i, None,  FunctionDefinition(p, e)
   }
 
-
 pattern:
 | i=located(identifier) {
     PVariable i
@@ -100,7 +122,7 @@ type_variable:
 
 
 type_constructor:
-| tcon=TID {
+| tcon=CID {
     TCon tcon
   }
 
@@ -116,6 +138,11 @@ literal:
     LInt i
   }
 
+label:
+| i=ID {
+    LId i
+  }
+
 
 identifier:
 | i=ID {