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

minimal liquidity integration

Browse Source
This commit is contained in:
Galfour 2019-04-13 08:59:32 +00:00
parent 87a0d8818b
commit 9ac9fdd562
5 changed files with 122 additions and 62 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/lib_utils/trace.ml
View File

@ -313,9 +313,16 @@ module Assert = struct
Option.unopt ~default msg in
assert_equal ~msg expected actual
let assert_none ?(msg="not a none") opt = match opt with
| None -> ok ()
| _ -> simple_fail msg
let assert_list_size ?(msg="lst doesn't have the right size") lst n =
assert_true ~msg List.(length lst = n)
let assert_list_empty ?(msg="lst isn't empty") lst =
assert_true ~msg List.(length lst = 0)
let assert_list_same_size ?(msg="lists don't have same size") a b =
assert_true ~msg List.(length a = length b)

3
src/ligo/contracts/basic.mligo Normal file
View File

@ -0,0 +1,3 @@
type toto = int
let foo : toto = 42 + 127

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

@ -32,6 +32,7 @@ module O = struct
| `Named of string
| `Token of token
| `List of string list_element
| `Option of string
]
type rhs = rhs_element list name
@ -61,7 +62,6 @@ module O = struct
| `Lower
]
type operator = element list
type n_operator = operator name
@ -166,6 +166,7 @@ module Print_AST = struct
match e with
| `Named s -> Some (s ^ " Location.wrap")
| `List ( _, s) -> Some ("(" ^ s ^ " Location.wrap list)")
| `Option s -> Some ("(" ^ s ^ " Location.wrap option)")
| `Token _ -> None
in
List.filter_map aux rhs.content in
@ -246,6 +247,7 @@ module Print_Grammar = struct
let aux : _ -> O.rhs_element -> _ = fun ppf e ->
(match e with
| `Named s -> fprintf ppf "%s = wrap(%s)" letters.(!i) s
| `Option s -> fprintf ppf "%s = option(wrap(%s))" letters.(!i) s
| `List (mode, s) ->
fprintf ppf "%s = %swrap(%s))"
letters.(!i)
@ -271,7 +273,7 @@ module Print_Grammar = struct
let i = ref 0 in
let aux : O.rhs_element -> _ = fun e ->
let s = (match e with
| `Named _ | `List _ -> Some (letters.(!i))
| `Named _ | `List _ | `Option _ -> Some (letters.(!i))
| `Token _ -> i := !i - 1 ; None) in
i := !i + 1 ; s
in
@ -626,13 +628,9 @@ module Type_expression = struct
let application = empty_infix "application" `Left
(* 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 ]
@ -671,14 +669,44 @@ module Program = struct
make_name "implicit_named_param" [ `Token TILDE ; `Named variable_name ] ;
]
let type_annotation_name = "type_annotation_"
let type_annotation : O.rule = make_name type_annotation_name [
make_name "" [ `Token COLON ; `Named type_expression_name ] ;
]
let let_content_name = "let_content"
let let_content : O.rule = make_name let_content_name [
make_name "" [
`Named variable_name ;
`List (Naked, param_name) ;
`Option type_annotation_name ;
`Token EQUAL ;
`Named expression_name ;
] ;
]
(* let statement : O.rule = make_name statement_name [
* make_name "variable_declaration" [`Token LET ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
* make_name "init_declaration" [`Token LET_INIT ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
* make_name "entry_declaration" [`Token LET_ENTRY ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
* make_name "type_declaration" [`Token TYPE ; `Named variable_name ; `Token EQUAL ; `Named type_expression_name] ;
* ] *)
let statement : O.rule = make_name statement_name [
make_name "variable_declaration" [`Token LET ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
make_name "init_declaration" [`Token LET_INIT ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
make_name "entry_declaration" [`Token LET_ENTRY ; `List (Naked_ne, param_name) ; `Token EQUAL ; `Named expression_name] ;
make_name "variable_declaration" [`Token LET ; `Named let_content_name] ;
make_name "init_declaration" [`Token LET_INIT ; `Named let_content_name] ;
make_name "entry_declaration" [`Token LET_ENTRY ; `Named let_content_name] ;
make_name "type_declaration" [`Token TYPE ; `Named variable_name ; `Token EQUAL ; `Named type_expression_name] ;
]
let singletons = List.map O.rule_singleton [program ; statement ; param]
let singletons = List.map O.rule_singleton [
let_content ;
type_annotation ;
program ;
statement ;
param ;
]
end

84
src/ligo/simplify_multifix.ml
View File

@ -5,8 +5,23 @@ module O = Ast_simplified
let unwrap : type a . a Location.wrap -> a = Location.unwrap
let type_constants = [
("unit", 0) ;
("string", 0) ;
("nat", 0) ;
("int", 0) ;
("bool", 0) ;
("list", 1) ;
("option", 1) ;
("set", 1) ;
("map", 2) ;
]
let type_variable : string -> O.type_expression result = fun str ->
ok @@ O.T_variable str
match List.assoc_opt str type_constants with
| Some 0 -> ok @@ O.T_constant (str, [])
| Some _ -> simple_fail "non-nullary type constructor"
| None -> ok @@ O.T_variable str
let rec type_expression : I.type_expression -> O.type_expression result = fun te ->
match te with
@ -60,7 +75,9 @@ let rec expression : I.expression -> O.annotated_expression result = fun e ->
| E_main m ->
let%bind m' = bind_map_location expression_main m in
ok @@ unwrap m'
| E_record r ->
| E_record r -> expression_record r
and expression_record : _ -> O.annotated_expression result = fun r ->
let aux : I.e_record_element -> _ = fun re ->
match re with
| E_record_element_record_implicit _ -> simple_fail "no implicit record element yet"
@ -141,42 +158,39 @@ and expression_main : I.expression_main -> O.annotated_expression result = fun e
and expression_no_seq : I.expression_no_seq -> O.annotated_expression result = fun mns ->
match mns with
| _ -> simple_fail "todo"
| Es_record r -> expression_record r
| Es_let_in _
| Es_ifthen _
| Es_ifthenelse _
-> simple_fail "not block expressions in local expressions yet"
| Es_fun _ -> simple_fail "no local functions yet"
| Es_match _ -> simple_fail "no match in expressions yet"
| Es_main e ->
expression_main (unwrap e)
let let_content : I.let_content -> _ result = fun (Let_content (n, args, ty_opt, e)) ->
let%bind () =
trace_strong (simple_error "no sugar-candy for args yet") @@
Assert.assert_list_empty args in
let%bind ty =
trace_option (simple_error "top-level declarations need a type") @@
ty_opt in
let%bind e' = bind_map_location expression e in
let%bind () =
trace_strong (simple_error "no annotation for a top-level expression") @@
Assert.assert_none (unwrap e').type_annotation in
let e'' = (unwrap e').expression in
let%bind ty' =
let (I.Type_annotation_ ty') = unwrap ty in
bind_map_location type_expression ty' in
let ae = O.annotated_expression e'' (Some (unwrap ty')) in
ok @@ O.Declaration_constant {name = (unwrap n) ; annotated_expression = ae}
let statement : I.statement -> O.declaration result = fun s ->
match s with
| Statement_variable_declaration ([n], e) ->
let%bind (name, ty) =
let%bind pattern =
match unwrap n with
| Param_restricted_pattern c -> ok c
| Param_implicit_named_param _ -> simple_fail "" in
match unwrap pattern with
| Pr_restrict c -> (
match unwrap c with
| P_type_annotation (l, te) -> (
let%bind v = match unwrap l with
| P_variable v -> ok v
| _ -> simple_fail "no sugar-candy for regular declarations yet"
in
ok (v, te)
)
| _ -> simple_fail "no sugar-candy for regular declarations yet"
)
| Pr_variable _ -> simple_fail "provide type for top-level declarations!"
| Pr_unit _ -> simple_fail "define unit is meaningless"
in
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%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"
| Statement_entry_declaration _ -> simple_fail "no entry declaration yet"
| Statement_variable_declaration x -> let_content (unwrap x)
| Statement_init_declaration x -> let_content (unwrap x)
| Statement_entry_declaration x -> let_content (unwrap x)
| Statement_type_declaration (n, te) ->
let%bind te' = bind_map_location type_expression te in
ok @@ O.Declaration_type {type_name = unwrap n ; type_expression = unwrap te'}

14
src/ligo/test/multifix_tests.ml
View File

@ -7,11 +7,19 @@ let basic () : unit result =
ok ()
let simplify () : unit result =
let%bind raw = User.parse_file "./contracts/new-syntax.mligo" in
let%bind raw = User.parse_file "./contracts/basic.mligo" in
let%bind _simpl = Ligo.Simplify_multifix.main raw in
ok ()
let main = "Parser Multifix", [
let integration () : unit result =
let%bind raw = User.parse_file "./contracts/basic.mligo" in
let%bind simpl = Ligo.Simplify_multifix.main raw in
let%bind typed = Ligo.Typer.type_program (Location.unwrap simpl) in
let%bind result = Ligo.easy_evaluate_typed "foo" typed in
Ligo.AST_Typed.assert_value_eq (Ligo.AST_Typed.Combinators.e_a_int (42 + 127), result)
let main = "Multifix", [
test "basic" basic ;
test "simplify" simplify ;
test "simplfiy" simplify ;
test "integration" integration ;
]