From 66af6713b556c287127f23b4bc8c273a28406c77 Mon Sep 17 00:00:00 2001
From: Nicolas PENELOUX <nicolas.peneloux@free.fr>
Date: Fri, 20 Oct 2023 20:45:16 +0200
Subject: [PATCH] essai parser

---
 flap/src/hopix/hopixLexer.mll  | 59 ++++++++++++++++++++--------------
 flap/src/hopix/hopixParser.mly | 48 +++++++++++++++++++++++----
 2 files changed, 75 insertions(+), 32 deletions(-)

diff --git a/flap/src/hopix/hopixLexer.mll b/flap/src/hopix/hopixLexer.mll
index ba2a316..072c566 100644
--- a/flap/src/hopix/hopixLexer.mll
+++ b/flap/src/hopix/hopixLexer.mll
@@ -50,9 +50,8 @@ let char = '\'' atom '\''
 
 let letter = (digit | ['A'-'Z'] | ['a'-'z'])
 (* pas sûr pour str *)
-(* let str = '\"' (([atom] | ['\''] | ["\\\""]) # '"')* '\"' *)
+let str = '\"' (atom | '\'' | "\\\"")* '\"'
 
-(* let binop = '+' | '-' | '*' | '/' | "&&" | "||"| "=?"| "<=?" |">=?" |"<?" |">?" *)
 
 
 rule token = parse
@@ -81,31 +80,41 @@ rule token = parse
   | "and"                 { AND_KW }
   | "for"                 { FOR    }
 
-  (** Binar operation : pas sûr pour celui là *)
-  (* | binop as b            { BINOP b } *)
+  (** Opérateurs binaires  *)
+  | "+"                   { PLUS         }
+  | "-"                   { MINUS        }
+  | "/"                   { SLASH        }
+  | "&&"                  { D_AND        }
+  | "||"                  { D_OR         }
+  | "=?"                  { EQUAL_OP     }
+  | "<=?"                 { INF_EQUAL_OP }
+  | ">=?"                 { SUP_EQUAL_OP }
+  | "<?"                  { INF_OP       }
+  | ">?"                  { SUP_OP       }
+
 
   (** Ponctuation *)
-  | '='                   { EQUAL    }
-  | '('                   { LPAREN   }
-  | ')'                   { RPAREN   }
-  | '['                   { LBRACK   }
-  | ']'                   { RBRACK   }
-  | '{'                   { LBRACE   }
-  | '}'                   { RBRACE   }
-  | '_'                   { WILDCARD }
-  | ':'                   { COLON    }
-  | ';'                   { SEMICOLON}
-  | "->"                  { ARROW    }
-  | '<'                   { INFERIOR }
-  | '>'                   { SUPERIOR }
-  | '|'                   { PIPE     }
-  | '&'                   { AND      }
-  | '*'                   { STAR     }
-  | ','                   { COMMA    }
-  | '.'                   { DOT      }
-  | '\\'                  {BACKSLASH }
-  | ":="                  { ASSIGN   }
-  | '!'                   { EXCLA    }
+  | '='                   { EQUAL     }
+  | '('                   { LPAREN    }
+  | ')'                   { RPAREN    }
+  | '['                   { LBRACK    }
+  | ']'                   { RBRACK    }
+  | '{'                   { LBRACE    }
+  | '}'                   { RBRACE    }
+  | '_'                   { WILDCARD  }
+  | ':'                   { COLON     }
+  | ';'                   { SEMICOLON }
+  | "->"                  { ARROW     }
+  | '<'                   { INFERIOR  }
+  | '>'                   { SUPERIOR  }
+  | '|'                   { PIPE      }
+  | '&'                   { AND       }
+  | '*'                   { STAR      }
+  | ','                   { COMMA     }
+  | '.'                   { DOT       }
+  | '\\'                  {BACKSLASH  }
+  | ":="                  { ASSIGN    }
+  | '!'                   { EXCLA     }
 
   (** Strings *)
   | '"'                   { read_string (Buffer.create 16) lexbuf }
diff --git a/flap/src/hopix/hopixParser.mly b/flap/src/hopix/hopixParser.mly
index 010c8b5..e4f9871 100644
--- a/flap/src/hopix/hopixParser.mly
+++ b/flap/src/hopix/hopixParser.mly
@@ -5,10 +5,11 @@
 
 %}
 
-%token EOF LET TYPE WILDCARD STAR ARROW COLON EXTERN FUN COMMA AND EQUAL LPAREN
+%token EOF LET TYPE WILDCARD ARROW COLON EXTERN FUN COMMA AND EQUAL LPAREN
 %token RPAREN LBRACK RBRACK LBRACE RBRACE INFERIOR SUPERIOR BINOP DO ELSE FOR
 %token FROM IF MATCH PIPE REF THEN TO UNTIL WHILE AND_KW DOT SEMICOLON BACKSLASH
 %token ASSIGN EXCLA
+%token PLUS MINUS STAR SLASH D_AND D_OR EQUAL_OP INF_EQUAL_OP SUP_EQUAL_OP INF_OP SUP_OP
 
 %token<Mint.t> INT
 %token<string> ID TID CID STRING
@@ -51,14 +52,24 @@ definition:
 
 tdefinition:
 /* Type sommes */
-/* | option(PIPE) type_constructor option() separated_nonempty_list(COMMA, ty) {
-    DefineSumType()
-  } */
+/* la définition étant assez compliqué, on va utilisé d'autre terme pour réduire la taille */
+| option(PIPE) l=separated_nonempty_list(PIPE,list_constructor_and_ty) {
+    DefineSumType(l)
+  } 
 /* Type produit étiqueté */
 | LBRACE lt=separated_nonempty_list(COMMA, label_with_type) RBRACE {
     DefineRecordType(lt)
   }
 
+list_constructor_and_ty: c=located(constructor) t=list_ty{
+  (c,t)
+}
+
+list_ty: LPAREN l=separated_nonempty_list(COMMA,located(ty)) RPAREN {
+  l
+}
+
+
 label_with_type:
 | l=located(label) COLON t=located(ty) { l, t }
 
@@ -341,8 +352,6 @@ simple_expression:
     Apply(e1,e2)
   }
 
-  /* TODO operation binaire mais j'ai pas très bien compris encore */
-
 
   /* Match (exp) {| ...| ... | ...} */
   | MATCH LPAREN e=located(expression) RPAREN 
@@ -351,10 +360,11 @@ simple_expression:
     }
 
   /* TODO if ( exp ) then { expr } j'ai RIEN COMPRIS */
+  
   /*
   | IF LPAREN e=located(expression) RPAREN
     THEN LBRACE e2=located(expression) RBRACE{
-      IfThenElse(e,e2,None)
+      IfThenElse(e,e2,Position.unknown_pos )
     }
 */
     /* if ( expr ) then { expr } else { expr } */
@@ -399,6 +409,8 @@ simple_expression:
     e
   }
 
+
+
   /* Annotation de type */
   /* (e : ty) */
   | LPAREN e=located(expression) COLON t=located(ty) RPAREN {
@@ -406,6 +418,14 @@ simple_expression:
   }
 
 
+  /* operateurs binaires */
+
+  /*
+  | e1=located(expression) b=binop e2=located(expression) {
+      Apply(Apply(b,e1),e2)
+  }*/
+
+
 
 
   
@@ -455,6 +475,20 @@ identifier:
   }
 
 
+%inline binop:
+/*| loc=located(PLUS)         { ("`+`",loc) }*/
+
+| MINUS        { "`-`" }
+| STAR         { "`*`" }
+| SLASH        { "`/`" }
+| D_AND        { "`&&`" }
+| D_OR         { "`||`" }
+| EQUAL_OP     { "`=?`" }
+| INF_EQUAL_OP { "`<=?`" }
+| SUP_EQUAL_OP { "`>=?`" }
+| INF_OP       { "`<?`" }
+| SUP_OP       { "`>?`" }
+
 %inline located(X): x=X {
   Position.with_poss $startpos $endpos x
 }