balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

integrate liquidity

Browse Source
This commit is contained in:
Galfour 2019-04-12 22:07:31 +00:00
parent 2499222b46
commit 87a0d8818b
5 changed files with 196 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/ligo/ast_simplified.ml
View File

@ -52,17 +52,17 @@ and lambda = {
and expression =
(* Base *)
| E_literal of literal
| E_constant of name * ae list (* For language constants, like (Cons hd tl) or (plus i j) *)
| E_constant of (name * ae list) (* For language constants, like (Cons hd tl) or (plus i j) *)
| E_variable of name
| E_lambda of lambda
| E_application of ae * ae
| E_application of (ae * ae)
(* E_Tuple *)
| E_tuple of ae list
(* Sum *)
| E_constructor of name * ae (* For user defined constructors *)
| E_constructor of (name * ae) (* For user defined constructors *)
(* E_record *)
| E_record of ae_map
| E_accessor of ae * access_path
| E_accessor of (ae * access_path)
(* Data Structures *)
| E_map of (ae * ae) list
| E_look_up of (ae * ae)

10
src/ligo/ast_typed.ml
View File

@ -57,18 +57,18 @@ and lambda = {
and expression =
(* Base *)
| E_literal of literal
| E_constant of name * ae list (* For language constants, like (Cons hd tl) or (plus i j) *)
| E_constant of (name * ae list) (* For language constants, like (Cons hd tl) or (plus i j) *)
| E_variable of name
| E_application of ae * ae
| E_application of (ae * ae)
| E_lambda of lambda
(* Tuple *)
| E_tuple of ae list
| E_tuple_accessor of ae * int (* Access n'th tuple's element *)
| E_tuple_accessor of (ae * int) (* Access n'th tuple's element *)
(* Sum *)
| E_constructor of name * ae (* For user defined constructors *)
| E_constructor of (name * ae) (* For user defined constructors *)
(* Record *)
| E_record of ae_map
| E_record_accessor of ae * string
| E_record_accessor of (ae * string)
(* Data Structures *)
| E_map of (ae * ae) list
| E_look_up of (ae * ae)

89
src/ligo/multifix/generator.ml
View File

@ -20,7 +20,9 @@ module O = struct
| Trail_force_ne of token
| Lead of token
| Lead_ne of token
| Separator of token
| Separated of token
| Separated_ne of token
| Separated_nene of token
| Naked
| Naked_ne
@ -256,7 +258,10 @@ module Print_Grammar = struct
| Trail_option s -> "trail_option_list(" ^ (Token.to_string s) ^ ","
| Trail_force s -> "trail_force_list(" ^ (Token.to_string s) ^ ","
| Trail_force_ne s -> "trail_force_list_ne(" ^ (Token.to_string s) ^ ","
| Separator s -> "separated_list(" ^ (Token.to_string s) ^ ",")
| Separated s -> "separated_list(" ^ (Token.to_string s) ^ ","
| Separated_ne s -> "separated_list_ne(" ^ (Token.to_string s) ^ ","
| Separated_nene s -> "separated_list_nene(" ^ (Token.to_string s) ^ ","
)
s
| `Token t -> i := !i - 1 ; string ppf @@ Token.to_string t) ;
i := !i + 1
@ -302,7 +307,10 @@ module Print_Grammar = struct
| Trail_option s -> "trail_option_list(" ^ (Token.to_string s) ^ ","
| Trail_force s -> "trail_force_list(" ^ (Token.to_string s) ^ ","
| Trail_force_ne s -> "trail_force_list_ne(" ^ (Token.to_string s) ^ ","
| Separator s -> "separated_list(" ^ (Token.to_string s) ^ ",")
| Separated s -> "separated_list(" ^ (Token.to_string s) ^ ","
| Separated_ne s -> "separated_list_ne(" ^ (Token.to_string s) ^ ","
| Separated_nene s -> "separated_list_nene(" ^ (Token.to_string s) ^ ","
)
(match content with | `Lower -> prev_lvl_name | `Named s -> s | `Current -> cur_lvl_name)
| `Named n ->
fprintf ppf "%s = wrap(%s)" letters.(!i) n
@ -376,13 +384,13 @@ end
let infix : string -> [`Left | `Right] -> token -> O.n_operator = fun name assoc t ->
match assoc with
| `Left -> make_name name [`Current ; `Token t ; `Lower]
| `Right -> make_name name [`Current ; `Token t ; `Lower]
| `Right -> make_name name [`Lower ; `Token t ; `Current]
(* Ocaml is bad *)
let empty_infix : string -> [`Left | `Right] -> O.n_operator = fun name assoc ->
match assoc with
| `Left -> make_name name [`Current ; `Lower]
| `Right -> make_name name [`Current ; `Lower]
| `Right -> make_name name [`Lower ; `Current]
let paren : string -> string -> O.n_operator = fun constructor_name name ->
@ -469,7 +477,7 @@ module Expression = struct
let application = empty_infix "application" `Right
let type_annotation = make_name "type_annotation" [
`Current ; `Token COLON ; `Named type_expression_name
`Current ; `Token COLON ; `Named restricted_type_expression_name
]
let list : O.n_operator = make_name "list" [
@ -517,7 +525,10 @@ module Expression = struct
`Lower ;
]
let sequence = infix "sequence" `Left SEMICOLON
(* let sequence = infix "sequence" `Left SEMICOLON *)
let sequence = make_name "sequence" [
`List (Separated_nene SEMICOLON , `Lower)
]
let match_clause = make_name "e_match_clause" [
make_name "" [`Named pattern_name ; `Token ARROW ; `Named no_match_name]
@ -556,14 +567,18 @@ module Expression = struct
let assignment : O.n_operator = infix "assign" `Left LEFT_ARROW
let pair = infix "pair" `Left COMMA
let tuple = make_name "tuple" [
`List (Separated_nene COMMA, `Lower)
]
let name = make_name "name" [`Token TILDE ; `Current]
let main_hierarchy = [
[pair] ;
[application] ;
let main_hierarchy_name = "expression_main"
let main_hierarchy = O.name_hierarchy main_hierarchy_name "Eh" [
[tuple] ;
[type_annotation] ;
[application] ;
[lt ; le ; gt ; eq] ;
[assignment] ;
[cons] ;
@ -573,23 +588,23 @@ module Expression = struct
[name] ;
[arith_variable ; constructor ; module_ident ; accessor ; int ; unit ; string ; tz] ;
[paren "bottom" expression_name] ;
]
] []
let no_sequence_expression = O.name_hierarchy no_seq_name "Es" (
[let_in ; fun_ ; record ; ite ; it ; match_with] ::
main_hierarchy
) []
let no_sequence_expression = O.name_hierarchy no_seq_name "Es" [
[let_in ; fun_ ; record ; ite ; it ; match_with] ;
[make_name "main" [`Named main_hierarchy_name]] ;
] []
let no_match_expression = O.name_hierarchy no_match_name "Em" (
[let_in ; fun_ ; record ; ite ; it ] ::
main_hierarchy
) []
let no_match_expression = O.name_hierarchy no_match_name "Em" [
[let_in ; fun_ ; record ; ite ; it ] ;
[make_name "main" [`Named main_hierarchy_name]] ;
] []
let expression = O.name_hierarchy expression_name "E" (
[sequence] ::
[let_in ; fun_ ; record ; ite ; it ; match_with] ::
main_hierarchy
) []
let expression = O.name_hierarchy expression_name "E" [
[sequence] ;
[let_in ; fun_ ; record ; ite ; it ; match_with] ;
[make_name "main" [`Named main_hierarchy_name]] ;
] []
let singletons = List.map O.rule_singleton [record_element ; match_clause]
end
@ -599,16 +614,6 @@ module Type_expression = struct
open Token
open O
let list : O.n_operator = make_name "list" [
`Token LIST ; `Token LSQUARE ; `List (Lead SEMICOLON, `Current) ; `Token RSQUARE ;
]
let let_in : O.n_operator = make_name "let_in" [
`Token LET ; `Named variable_name ;
`Token EQUAL ; `Current ;
`Token IN ; `Current ;
]
let record_element : O.rule = make_name "t_record_element" [
make_name "" [`Named variable_name ; `Token COLON ; `Named type_expression_name]
]
@ -621,7 +626,13 @@ module Type_expression = struct
let application = empty_infix "application" `Left
let pair = infix "pair" `Left COMMA
(* let pair = infix "pair" `Left COMMA *)
let tuple = make_name "tuple" [
`List (Separated_nene COMMA, `Lower)
]
(* let pair = make_name "tuple" [
* `List (Separated COMMA, `Lower)
* ] *)
let type_variable : O.n_operator = make_name "variable" [ `Named variable_name ]
@ -631,10 +642,9 @@ module Type_expression = struct
] []
let type_expression = O.name_hierarchy type_expression_name "T" [
[let_in ; record ] ;
[pair] ;
[record] ;
[tuple] ;
[application] ;
[list] ;
[type_variable] ;
[paren "paren" type_expression_name]
] []
@ -681,6 +691,7 @@ let language = O.language program_name (
) [
Pattern.main ;
Pattern.restricted_pattern ;
Expression.main_hierarchy ;
Expression.no_sequence_expression ;
Expression.no_match_expression ;
Expression.expression ;

9
src/ligo/multifix/pre_parser.mly
View File

@ -59,5 +59,14 @@ lead_list_content(separator, X):
lead_list_first (separator, X):
| option(separator) x = X { [ x ] }
separated_list_ne(separator, X):
| x = X { [x] }
| x = X separator xs = separated_list_ne(separator, X) { x :: xs }
separated_list_nene(separator, X):
| x = X separator y = X { [x ; y] }
| x = X separator xs = separated_list_nene(separator, X) { x :: xs }
%inline wrap(X):
| x = X { let loc = Location.make $startpos $endpos in Location.wrap ~loc x }

135
src/ligo/simplify_multifix.ml
View File

@ -3,20 +3,43 @@ open Function
module I = Multifix.Ast
module O = Ast_simplified
let unwrap = Location.unwrap
let expression : I.expression -> O.expression result = fun _ ->
simple_fail ""
let unwrap : type a . a Location.wrap -> a = Location.unwrap
let type_variable : string -> O.type_expression result = fun str ->
ok @@ O.T_variable str
let type_expression : I.type_expression -> O.type_expression result = fun te ->
let rec type_expression : I.type_expression -> O.type_expression result = fun te ->
match te with
| T_variable tv ->
let%bind tv' = bind_map_location type_variable tv in
ok @@ unwrap tv'
| _ -> simple_fail "lel"
| T_tuple lst ->
let%bind lst' = bind_map_list (bind_map_location type_expression) lst in
ok @@ O.T_tuple (List.map unwrap lst')
| T_paren p ->
let%bind p' = bind_map_location type_expression p in
ok @@ unwrap p'
| T_record r ->
let aux : I.t_record_element -> _ = fun (T_record_element (s, te)) ->
let%bind te' = bind_map_location type_expression te in
ok (s, te')
in
let%bind r' = bind_map_list (bind_map_location aux) r in
let te_map =
let lst = List.map ((fun (x, y) -> unwrap x, unwrap y) >| unwrap) r' in
let open Map.String in
List.fold_left (fun prec (k , v) -> add k v prec) empty lst
in
ok @@ O.T_record te_map
| T_application (f, arg) ->
let%bind (f', arg') = bind_map_pair (bind_map_location type_expression) (f, arg) in
let%bind name = match unwrap f' with
| O.T_variable v -> ok v
| _ -> simple_fail "can't apply to non-vars" in
let args = match unwrap arg' with
| T_tuple lst -> lst
| x -> [ x ] in
ok @@ O.T_constant (name, args)
let restricted_type_expression : I.restricted_type_expression -> O.type_expression result = fun rte ->
match rte with
@ -25,6 +48,101 @@ let restricted_type_expression : I.restricted_type_expression -> O.type_expressi
ok @@ unwrap tv'
| Tr_paren te -> type_expression (unwrap te)
let rec expression : I.expression -> O.annotated_expression result = fun e ->
match e with
| E_sequence _
| E_let_in _
| E_ifthen _
| E_ifthenelse _
-> simple_fail "not block expressions in local expressions yet"
| E_fun _ -> simple_fail "no local functions yet"
| E_match _ -> simple_fail "no match in expressions yet"
| E_main m ->
let%bind m' = bind_map_location expression_main m in
ok @@ unwrap m'
| E_record r ->
let aux : I.e_record_element -> _ = fun re ->
match re with
| E_record_element_record_implicit _ -> simple_fail "no implicit record element yet"
| E_record_element_record_explicit (s, e) ->
let%bind e' = bind_map_location expression_no_seq e in
ok (s, e')
in
let%bind r' = bind_map_list (bind_map_location aux) r in
let e_map =
let lst = List.map ((fun (x, y) -> unwrap x, unwrap y) >| unwrap) r' in
let open Map.String in
List.fold_left (fun prec (k , v) -> add k v prec) empty lst
in
ok @@ O.(ae @@ E_record e_map)
and expression_main : I.expression_main -> O.annotated_expression result = fun em ->
let return x = ok O.(ae x) in
let simple_binop name ab =
let%bind (a' , b') = bind_map_pair (bind_map_location expression_main) ab in
return @@ E_constant (name, [unwrap a' ; unwrap b']) in
match em with
| Eh_tuple lst ->
let%bind lst' = bind_map_list (bind_map_location expression_main) lst in
return @@ E_tuple (List.map unwrap lst')
| Eh_application farg ->
(* TODO: constructor case *)
let%bind farg' = bind_map_pair (bind_map_location expression_main) farg in
return @@ E_application (Tuple.map2 unwrap farg')
| Eh_type_annotation (e, te) ->
let%bind e' = bind_map_location expression_main e in
let%bind e'' = match (unwrap e').type_annotation with
| None -> ok (unwrap e').expression
| Some _ -> simple_fail "can't double annotate" in
let%bind te' = bind_map_location restricted_type_expression te in
ok @@ O.annotated_expression e'' (Some (unwrap te'))
| Eh_lt ab ->
simple_binop "LT" ab
| Eh_gt ab ->
simple_binop "GT" ab
| Eh_le ab ->
simple_binop "LE" ab
| Eh_eq ab ->
simple_binop "EQ" ab
| Eh_cons ab ->
simple_binop "CONS" ab
| Eh_addition ab ->
simple_binop "ADD" ab
| Eh_substraction ab ->
simple_binop "MINUS" ab
| Eh_multiplication ab ->
simple_binop "TIMES" ab
| Eh_division ab ->
simple_binop "DIV" ab
| Eh_int n ->
return @@ E_literal (Literal_int (unwrap n))
| Eh_string s ->
return @@ E_literal (Literal_string (unwrap s))
| Eh_unit _ ->
return @@ E_literal Literal_unit
| Eh_tz _ ->
simple_fail "tz literals not supported yet"
| Eh_module_ident _ ->
simple_fail "modules not supported yet"
| Eh_variable v ->
return @@ E_variable (unwrap v)
| Eh_constructor _ ->
simple_fail "constructor without parameter"
| Eh_list _ ->
simple_fail "list not supported yet"
| Eh_name _ ->
simple_fail "named parameter not supported yet"
| Eh_assign _ ->
simple_fail "assign not supported yet"
| Eh_accessor _ ->
simple_fail "accessor not supported yet"
| Eh_bottom e ->
expression (unwrap e)
and expression_no_seq : I.expression_no_seq -> O.annotated_expression result = fun mns ->
match mns with
| _ -> simple_fail "todo"
let statement : I.statement -> O.declaration result = fun s ->
match s with
| Statement_variable_declaration ([n], e) ->
@ -51,7 +169,10 @@ let statement : I.statement -> O.declaration result = fun s ->
let name' = unwrap name in
let%bind e' = bind_map_location expression e in
let%bind ty' = bind_map_location restricted_type_expression ty in
let ae = O.annotated_expression (unwrap e') (Some (unwrap ty')) in
let%bind e'' = match (unwrap e').type_annotation with
| None -> ok (unwrap e').expression
| Some _ -> simple_fail "can't add an annotation at the expression of a declaration" in
let ae = O.annotated_expression e'' (Some (unwrap ty')) in
ok @@ O.Declaration_constant {name = name' ; annotated_expression = ae}
| Statement_variable_declaration _ -> simple_fail "no sugar-candy for fun declarations yet"
| Statement_init_declaration _ -> simple_fail "no init declaration yet"