Commit 4242dd93 authored by Andrei Paskevich's avatar Andrei Paskevich

accept type expressions as arguments for metas

parent e8361058
...@@ -150,8 +150,19 @@ let load_driver = let driver_tag = ref (-1) in fun env file extra_files -> ...@@ -150,8 +150,19 @@ let load_driver = let driver_tag = ref (-1) in fun env file extra_files ->
let td = remove_prop (find_pr th q) in let td = remove_prop (find_pr th q) in
add_meta th td (if c then meta_cl else meta) add_meta th td (if c then meta_cl else meta)
| Rmeta (c,s,al) -> | Rmeta (c,s,al) ->
let rec ty_of_pty = function
| PTyvar x ->
Ty.ty_var (Typing.create_user_tv x)
| PTyapp ((loc,_) as q,tyl) ->
let ts = find_ts th q in
let tyl = List.map ty_of_pty tyl in
Loc.try2 loc Ty.ty_app ts tyl
| PTuple tyl ->
let ts = Ty.ts_tuple (List.length tyl) in
Ty.ty_app ts (List.map ty_of_pty tyl)
in
let convert = function let convert = function
| PMAts q -> MAts (find_ts th q) | PMAty ty -> MAty (ty_of_pty ty)
| PMAfs q -> MAls (find_fs th q) | PMAfs q -> MAls (find_fs th q)
| PMAps q -> MAls (find_ps th q) | PMAps q -> MAls (find_ps th q)
| PMApr q -> MApr (find_pr th q) | PMApr q -> MApr (find_pr th q)
......
...@@ -15,8 +15,13 @@ type qualid = loc * string list ...@@ -15,8 +15,13 @@ type qualid = loc * string list
type cloned = bool type cloned = bool
type pty =
| PTyvar of string
| PTyapp of qualid * pty list
| PTuple of pty list
type metarg = type metarg =
| PMAts of qualid | PMAty of pty
| PMAfs of qualid | PMAfs of qualid
| PMAps of qualid | PMAps of qualid
| PMApr of qualid | PMApr of qualid
......
...@@ -40,6 +40,7 @@ ...@@ -40,6 +40,7 @@
"time", TIME; "time", TIME;
"unknown", UNKNOWN; "unknown", UNKNOWN;
"fail", FAIL; "fail", FAIL;
"constant", CONSTANT;
"function", FUNCTION; "function", FUNCTION;
"predicate", PREDICATE; "predicate", PREDICATE;
"type", TYPE; "type", TYPE;
...@@ -93,6 +94,8 @@ rule token = parse ...@@ -93,6 +94,8 @@ rule token = parse
{ DOT } { DOT }
| "," | ","
{ COMMA } { COMMA }
| "'"
{ QUOTE }
| op_char+ as op | op_char+ as op
{ OPERATOR op } { OPERATOR op }
| "\"" | "\""
......
...@@ -27,13 +27,16 @@ ...@@ -27,13 +27,16 @@
%token <string> OPERATOR %token <string> OPERATOR
%token THEORY END SYNTAX REMOVE META PRELUDE PRINTER %token THEORY END SYNTAX REMOVE META PRELUDE PRINTER
%token VALID INVALID TIMEOUT OUTOFMEMORY UNKNOWN FAIL TIME %token VALID INVALID TIMEOUT OUTOFMEMORY UNKNOWN FAIL TIME
%token UNDERSCORE LEFTPAR RIGHTPAR CLONED DOT EOF %token UNDERSCORE LEFTPAR RIGHTPAR CLONED DOT QUOTE EOF
%token BLACKLIST %token BLACKLIST
%token MODULE EXCEPTION VAL %token MODULE EXCEPTION VAL
%token FUNCTION PREDICATE TYPE PROP FILENAME TRANSFORM PLUGIN %token FUNCTION PREDICATE TYPE PROP FILENAME TRANSFORM PLUGIN
%token LEFTPAR_STAR_RIGHTPAR COMMA %token LEFTPAR_STAR_RIGHTPAR COMMA CONSTANT
%token LEFTSQ RIGHTSQ LARROW %token LEFTSQ RIGHTSQ LARROW
%nonassoc SYNTAX REMOVE PRELUDE
%nonassoc prec_pty
%type <Driver_ast.file> file %type <Driver_ast.file> file
%start file %start file
%type <Driver_ast.file_extract> file_extract %type <Driver_ast.file_extract> file_extract
...@@ -88,6 +91,7 @@ list0_trule: ...@@ -88,6 +91,7 @@ list0_trule:
trule: trule:
| PRELUDE STRING { Rprelude ($2) } | PRELUDE STRING { Rprelude ($2) }
| SYNTAX cloned TYPE qualid STRING { Rsyntaxts ($2, $4, $5) } | SYNTAX cloned TYPE qualid STRING { Rsyntaxts ($2, $4, $5) }
| SYNTAX cloned CONSTANT qualid STRING { Rsyntaxfs ($2, $4, $5) }
| SYNTAX cloned FUNCTION qualid STRING { Rsyntaxfs ($2, $4, $5) } | SYNTAX cloned FUNCTION qualid STRING { Rsyntaxfs ($2, $4, $5) }
| SYNTAX cloned PREDICATE qualid STRING { Rsyntaxps ($2, $4, $5) } | SYNTAX cloned PREDICATE qualid STRING { Rsyntaxps ($2, $4, $5) }
| REMOVE cloned PROP qualid { Rremovepr ($2, $4) } | REMOVE cloned PROP qualid { Rremovepr ($2, $4) }
...@@ -101,7 +105,7 @@ meta_args: ...@@ -101,7 +105,7 @@ meta_args:
; ;
meta_arg: meta_arg:
| TYPE qualid { PMAts $2 } | TYPE primitive_type_top { PMAty $2 }
| FUNCTION qualid { PMAfs $2 } | FUNCTION qualid { PMAfs $2 }
| PREDICATE qualid { PMAps $2 } | PREDICATE qualid { PMAps $2 }
| PROP qualid { PMApr $2 } | PROP qualid { PMApr $2 }
...@@ -163,6 +167,49 @@ list1_string_list: ...@@ -163,6 +167,49 @@ list1_string_list:
| list1_string_list STRING { $2 :: $1 } | list1_string_list STRING { $2 :: $1 }
; ;
/* Types */
primitive_type_top:
| qualid primitive_type_args_top { PTyapp ($1, $2) }
| primitive_type_arg_common { $1 }
;
primitive_type_args_top:
| /* epsilon */ %prec prec_pty { [] }
| primitive_type_arg primitive_type_args_top { $1 :: $2 }
;
primitive_type:
| qualid primitive_type_args { PTyapp ($1, $2) }
| primitive_type_arg { $1 }
;
primitive_type_args:
| primitive_type_arg { [$1] }
| primitive_type_arg primitive_type_args { $1 :: $2 }
;
primitive_type_arg:
| qualid { PTyapp ($1, []) }
| primitive_type_arg_common { $1 }
;
primitive_type_arg_common:
| type_var { PTyvar $1 }
| LEFTPAR primitive_types RIGHTPAR { PTuple $2 }
| LEFTPAR RIGHTPAR { PTuple [] }
| LEFTPAR primitive_type RIGHTPAR { $2 }
;
primitive_types:
| primitive_type COMMA primitive_type { [$1; $3] }
| primitive_type COMMA primitive_types { $1 :: $3 }
;
type_var:
| QUOTE ident { $2 }
;
/* WhyML */ /* WhyML */
file_extract: file_extract:
......
...@@ -379,7 +379,8 @@ list1_meta_arg_sep_comma: ...@@ -379,7 +379,8 @@ list1_meta_arg_sep_comma:
; ;
meta_arg: meta_arg:
| TYPE qualid { PMAts $2 } | TYPE primitive_type { PMAty $2 }
| CONSTANT qualid { PMAfs $2 }
| FUNCTION qualid { PMAfs $2 } | FUNCTION qualid { PMAfs $2 }
| PREDICATE qualid { PMAps $2 } | PREDICATE qualid { PMAps $2 }
| PROP qualid { PMApr $2 } | PROP qualid { PMApr $2 }
......
...@@ -148,7 +148,7 @@ type prop_kind = ...@@ -148,7 +148,7 @@ type prop_kind =
| Kaxiom | Klemma | Kgoal | Kaxiom | Klemma | Kgoal
type metarg = type metarg =
| PMAts of qualid | PMAty of pty
| PMAfs of qualid | PMAfs of qualid
| PMAps of qualid | PMAps of qualid
| PMApr of qualid | PMApr of qualid
......
...@@ -1115,7 +1115,7 @@ let add_decl loc th = function ...@@ -1115,7 +1115,7 @@ let add_decl loc th = function
add_prop (prop_kind k) loc s f th add_prop (prop_kind k) loc s f th
| Meta (id, al) -> | Meta (id, al) ->
let convert = function let convert = function
| PMAts q -> MAts (find_tysymbol q th) | PMAty ty -> MAty (ty_of_pty th ty)
| PMAfs q -> MAls (find_fsymbol q th) | PMAfs q -> MAls (find_fsymbol q th)
| PMAps q -> MAls (find_psymbol q th) | PMAps q -> MAls (find_psymbol q th)
| PMApr q -> MApr (find_prop q th) | PMApr q -> MApr (find_prop q th)
......
...@@ -115,8 +115,19 @@ let load_driver lib file extra_files = ...@@ -115,8 +115,19 @@ let load_driver lib file extra_files =
| Rremovepr (_,q) -> | Rremovepr (_,q) ->
ignore (find_pr th q) ignore (find_pr th q)
| Rmeta (_,s,al) -> | Rmeta (_,s,al) ->
let rec ty_of_pty = function
| PTyvar x ->
Ty.ty_var (Typing.create_user_tv x)
| PTyapp ((loc,_) as q,tyl) ->
let ts = find_ts th q in
let tyl = List.map ty_of_pty tyl in
Loc.try2 loc Ty.ty_app ts tyl
| PTuple tyl ->
let ts = Ty.ts_tuple (List.length tyl) in
Ty.ty_app ts (List.map ty_of_pty tyl)
in
let convert = function let convert = function
| PMAts q -> MAts (find_ts th q) | PMAty ty -> MAty (ty_of_pty ty)
| PMAfs q -> MAls (find_fs th q) | PMAfs q -> MAls (find_fs th q)
| PMAps q -> MAls (find_ps th q) | PMAps q -> MAls (find_ps th q)
| PMApr q -> MApr (find_pr th q) | PMApr q -> MApr (find_pr th q)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment