First commit towards more powerful disambiguation possibilities, where

[helm.git] / helm / ocaml / cic_textual_parser / cicTextualParser.mly

diff --git a/helm/ocaml/cic_textual_parser/cicTextualParser.mly b/helm/ocaml/cic_textual_parser/cicTextualParser.mly
index 9f045ed36d76de9a1278c211aaf31aba1ba978c4..08d85a595a2b03c358f07586ffdd4eb86ab5c30a 100644 (file)
--- a/helm/ocaml/cic_textual_parser/cicTextualParser.mly
+++ b/helm/ocaml/cic_textual_parser/cicTextualParser.mly
@@ -120,7 +120,7 @@
 
  let var_uri_of_id id interp =
   let module CTP0 = CicTextualParser0 in
-   match interp id with
+   match interp (CicTextualParser0.Id id) with
       None -> raise (UnknownIdentifier id)
     | Some (CTP0.Uri (CTP0.VarUri uri)) -> uri
     | Some _ -> raise TheLeftHandSideOfAnExplicitNamedSubstitutionMustBeAVariable
@@ -128,9 +128,9 @@
 
  let indty_uri_of_id id interp =
   let module CTP0 = CicTextualParser0 in
-   match interp id with
+   match interp (CicTextualParser0.Id id) with
       None -> raise (UnknownIdentifier id)
-    | Some (CTP0.Uri (CTP0.IndTyUri (uri,tyno)) -> (uri,tyno)
+    | Some (CTP0.Uri (CTP0.IndTyUri (uri,tyno))) -> (uri,tyno)
     | Some _ -> raise InductiveTypeURIExpected
  ;;
 
@@ -155,15 +155,18 @@
 %token <UriManager.uri> VARURI
 %token <UriManager.uri * int> INDTYURI
 %token <UriManager.uri * int * int> INDCONURI
-%token ALIAS
 %token LPAREN RPAREN PROD LAMBDA COLON DOT SET PROP TYPE CAST IMPLICIT NONE
 %token LETIN FIX COFIX SEMICOLON LCURLY RCURLY CASE ARROW LBRACKET RBRACKET EOF
 %right ARROW
 %start main
-%type <string list * ((string -> CicTextualParser0.interp_codomain option) -> Cic.term)> main
+%type <CicTextualParser0.interpretation_domain_item list * (CicTextualParser0.interpretation -> Cic.term)> main
 %%
 main:
- expr EOF { $1 }
+ | EOF { raise CicTextualParser0.Eof } /* FG: was never raised */
+ | expr EOF { $1 }
+ | expr SEMICOLON { $1 } /*  FG: to read several terms in a row
+                          *  Do we need to clear some static variables? 
+                         */
 ;
 expr2:
    CONURI exp_named_subst
@@ -194,22 +197,24 @@ expr2:
      with
       Not_found ->
        let dom1,mk_exp_named_subst = deoptionize_exp_named_subst $2 in
-        let dom = union dom1 [$1] in
+        let dom = union dom1 [CicTextualParser0.Id $1] in
          dom,
           function interp ->
-           match interp $1 with
+           match interp (CicTextualParser0.Id $1) with
              None  -> raise (UnknownIdentifier $1)
            | Some (CicTextualParser0.Uri uri) ->
                term_of_uri uri (mk_exp_named_subst interp)
             | Some CicTextualParser0.Implicit ->
                (*CSC: not very clean; to maximize code reusage *)
                snd (mk_implicit ()) ""
+            | Some (CicTextualParser0.Term mk_term) ->
+               (mk_term interp)
    }
  | CASE LPAREN expr COLON INDTYURI SEMICOLON expr RPAREN LCURLY branches RCURLY
     { let dom1,mk_expr1 = $3 in
       let dom2,mk_expr2 = $7 in
       let dom3,mk_expr3 = $10 in
-       let dom = union dom1 (union dom2 dom3) in
+       let dom = (union  dom1 (union dom2 dom3)) in
         dom,
         function interp ->
          MutCase
@@ -219,7 +224,7 @@ expr2:
     { let dom1,mk_expr1 = $3 in
       let dom2,mk_expr2 = $7 in
       let dom3,mk_expr3 = $10 in
-       let dom = union [$5] (union dom1 (union dom2 dom3)) in
+       let dom = union [CicTextualParser0.Id $5] (union dom1 (union dom2 dom3)) in
         dom,
         function interp ->
          let uri,typeno = indty_uri_of_id $5 interp in
@@ -294,14 +299,16 @@ expr2:
     { let dom,mk_substitutionlist = $3 in
        dom, function interp -> Meta ($1, mk_substitutionlist interp)
     } 
- | LPAREN expr expr exprlist RPAREN
-    { let dom1,mk_expr1 = $2 in
-      let dom2,mk_expr2 = $3 in
-      let dom3,mk_exprlist = $4 in
-       let dom = union dom1 (union dom2 dom3) in
-        dom,
-         function interp ->
-          Appl ([mk_expr1 interp ; mk_expr2 interp]@(mk_exprlist interp))
+ | LPAREN expr exprlist RPAREN
+    { let length,dom2,mk_exprlist = $3 in
+       match length with
+          0 -> $2
+        | _ ->
+          let dom1,mk_expr1 = $2 in
+           let dom = union dom1 dom2 in
+            dom,
+             function interp ->
+              Appl ((mk_expr1 interp)::(mk_exprlist interp))
     }
 ;
 exp_named_subst :
@@ -315,7 +322,7 @@ named_substs :
        dom, function interp -> [$1, mk_expr interp] }
  | ID LETIN expr2
     { let dom1,mk_expr = $3 in
-       let dom = union [$1] dom1 in
+       let dom = union [CicTextualParser0.Id $1] dom1 in
         dom, function interp -> [var_uri_of_id $1 interp, mk_expr interp] }
  | VARURI LETIN expr2 SEMICOLON named_substs
     { let dom1,mk_expr = $3 in
@@ -326,7 +333,7 @@ named_substs :
  | ID LETIN expr2 SEMICOLON named_substs
     { let dom1,mk_expr = $3 in
       let dom2,mk_named_substs = $5 in
-       let dom = union [$1] (union dom1 dom2) in
+       let dom = union [CicTextualParser0.Id $1] (union dom1 dom2) in
         dom,
          function interp ->
           (var_uri_of_id $1 interp, mk_expr interp)::(mk_named_substs interp)
@@ -414,11 +421,6 @@ pihead:
      let dom,mk_expr = $1 in
       Anonymous, (dom, function interp -> mk_expr interp)
    }
- | LPAREN expr RPAREN ARROW
-   { CicTextualParser0.binders := (Some Anonymous)::!CicTextualParser0.binders ;
-     let dom,mk_expr = $2 in
-      Anonymous, (dom, function interp -> mk_expr interp)
-   }
  | PROD ID DOT
     { CicTextualParser0.binders := (Some (Name $2))::!CicTextualParser0.binders;
       let newmeta = new_meta () in
@@ -475,12 +477,12 @@ branches:
 ;
 exprlist:
     
-    { [], function _ -> [] }
+    { 0, [], function _ -> [] }
  | expr exprlist
     { let dom1,mk_expr = $1 in
-      let dom2,mk_exprlist = $2 in
+      let length,dom2,mk_exprlist = $2 in
        let dom = union dom1 dom2 in
-        dom, function interp -> (mk_expr interp)::(mk_exprlist interp)
+        length+1, dom, function interp -> (mk_expr interp)::(mk_exprlist interp)
     }
 ;
 exprseplist: