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

Merge branch 'dev' into feature/more-applications-pascaligo

Browse Source
This commit is contained in:
galfour 2019-11-18 09:53:57 +01:00
commit 5422049dba
39 changed files with 266 additions and 253 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.dockerignore
View File

@ -1,4 +1,3 @@
dist
_opam
_build
docker

11
.gitlab-ci.yml
View File

@ -5,10 +5,10 @@ variables:
package_binary_script: "./scripts/distribution/generic/package.sh"
stages:
- build_docker
- test
- build_and_deploy_docker
- build_and_package_binaries
- build_docker
- build_and_deploy_docker
- build_and_deploy_website
.build_binary: &build_binary
@ -19,9 +19,6 @@ stages:
artifacts:
paths:
- dist/package/**/*
only:
- master
- dev
.website_build: &website_build
stage: build_and_deploy_website
@ -92,6 +89,8 @@ local-dune-job:
# Run a docker build without publishing to the registry
build-current-docker-image:
stage: build_docker
dependencies:
- build-and-package-debian-10
<<: *docker
script:
- sh scripts/build_docker_image.sh
@ -105,6 +104,8 @@ build-current-docker-image:
build-and-publish-latest-docker-image:
stage: build_and_deploy_docker
<<: *docker
dependencies:
- build-and-package-debian-10
script:
- sh scripts/build_docker_image.sh
- sh scripts/test_cli.sh

4
dist/.gitignore vendored
View File

@ -1,4 +0,0 @@
# Ignore everything in this directory
*
# Except this file
!.gitignore

9
docker/distribution/debian/distribute.Dockerfile
View File

@ -0,0 +1,9 @@
FROM jgoerzen/debian-base-minimal:buster
COPY ./dist/package/debian-10 /package/dist
RUN apt-get update -qq
RUN apt-get -y -f install "/package/dist/$(ls /package/dist)"
RUN rm -r /package/dist
ENTRYPOINT [ "ligo" ]

2
docker/distribution/debian/package.Dockerfile
View File

@ -19,7 +19,7 @@ RUN echo "Package: ligo\n\
Version: $version\n\
Architecture: all\n\
Maintainer: info@ligolang.org\n\
Depends: libev-dev, perl, pkg-config, libgmp-dev, libhidapi-dev, m4, libcap-dev, bubblewrap, rsync\n\
Depends: libev4, libgmp10, libgmpxx4ldbl, cpp\n\
Homepage: http://ligolang.org\n\
Description: LIGO is a statically typed high-level smart-contract language that compiles down to Michelson." >> /package/DEBIAN/control

0
gitlab-pages/docs/language-basics/cheat-sheet.md → gitlab-pages/docs/api/cheat-sheet.md
View File

2
gitlab-pages/docs/api-cli-commands.md → gitlab-pages/docs/api/cli-commands.md
View File

@ -1,5 +1,5 @@
---
id: api-cli-commands
id: cli-commands
title: CLI Commands
---

8
gitlab-pages/docs/language-basics/boolean-if-else.md
View File

@ -82,14 +82,14 @@ let h: bool = (a =/= b)
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
const a: tez = 5mtz;
const b: tez = 10mtz;
const a: tez = 5mutez;
const b: tez = 10mutez;
const c: bool = (a = b);
```
<!--Cameligo-->
```cameligo
let a: tez = 5mtz
let b: tez = 10mtz
let a: tez = 5mutez
let b: tez = 10mutez
// false
let c: bool = (a = b)
```

46
gitlab-pages/docs/language-basics/entrypoints.md
View File

@ -1,46 +0,0 @@
---
id: entrypoints
title: Entrypoints
---
Entrypoints are the gates to a smart contract. In LIGO each entrypoint is a function that accepts two arguments. The first is the parameter used to invoke the contract, and the second is the current storage of the contract. Each entrypoint must return a list of operations to apply as a result of the smart contract call, and a new storage value.
> If you don't want to update the storage, don't worry, just re-cycle your last storage value.
## Defining an entry point
The contract below is effectively an empty contract. It takes a `unit` as a parameter, and returns a `unit`.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
function main (const p : unit ; const s : unit) : (list(operation) * unit) is
block {skip} with ((nil : list(operation)), s)
```
<!--END_DOCUSAURUS_CODE_TABS-->
## Multiple entry points
Multiple entrypoints are currently not supported in Michelson. But with Ligo you can work around that by using variants & pattern matching.
In the example below we have a simple counter contract, that can be either `Increment(int)`-ed, or `Decrement(int)`-ed.
<!--DOCUSAURUS_CODE_TABS-->
<!--Pascaligo-->
```pascaligo
// variant defining pseudo multi-entrypoint actions
type action is
| Increment of int
| Decrement of int
// real entrypoint that re-routes the flow based on the action (parameter) provided
function main (const action: action ; const counter: int) : (list(operation) * int) is
block {skip} with ((nil : list(operation)),
case action of
| Increment(number) -> counter + number
| Decrement(number) -> counter - number
end)
```
<!--END_DOCUSAURUS_CODE_TABS-->

8
gitlab-pages/docs/language-basics/maps-records.md
View File

@ -31,8 +31,8 @@ And here's how a map value is populated:
```pascaligo
const ledger: ledger = map
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> 1000mtz;
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) -> 2000mtz;
("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address) -> 1000mutez;
("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address) -> 2000mutez;
end
```
> Notice the `->` between the key and its value and `;` to separate individual map entries.
@ -43,8 +43,8 @@ end
```cameligo
let ledger: ledger = Map.literal
[ (("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address), 1000mtz) ;
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), 2000mtz) ;
[ (("tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx": address), 1000mutez) ;
(("tz1gjaF81ZRRvdzjobyfVNsAeSC6PScjfQwN": address), 2000mutez) ;
]
```
> Map.literal constructs the map from a list of key-value pair tuples, `(<key>, <value>)`.

2
gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-payout.md
View File

@ -72,7 +72,7 @@ const ownerAddress : address = "tz1TGu6TN5GSez2ndXXeDX6LgUDvLzPLqgYV";
const receiver : contract(unit) = get_contract(ownerAddress);
```
> Would you like to learn more about addresses, contracts and operations in LIGO? Check out the [LIGO cheat sheet](language-basics/cheat-sheet.md)
> Would you like to learn more about addresses, contracts and operations in LIGO? Check out the [LIGO cheat sheet](api/cheat-sheet.md)
### Adding the transaction to the list of output operations
Now we can transfer the `amount` received by `buy_taco` to Pedro's `ownerAddress`. We will do so by forging a `transaction(unit, amount, receiver)` within a list of operations returned at the end of our contract.

4
gitlab-pages/docs/tutorials/get-started/tezos-taco-shop-smart-contract.md
View File

@ -57,7 +57,7 @@ current_purchase_price = max_price / available_stock
## Installing LIGO
In this tutorial, we'll use LIGO's dockerized version for the sake of simplicity. You can find the installation instructions [here](setup/installation.md#dockerized-installation-recommended).
In this tutorial, we'll use LIGO's dockerized version for the sake of simplicity. You can find the installation instructions [here](intro/installation.md#dockerized-installation-recommended).
The best way to install the dockerized LIGO is as a **global executable** through the installation script, as shown in the screenshot below:
@ -66,7 +66,7 @@ The best way to install the dockerized LIGO is as a **global executable** throug
## Implementing our first entry point
> From now on we'll get a bit more technical. If you run into something we have not covered yet - please try checking out the [LIGO cheat sheet](language-basics/cheat-sheet.md) for some extra tips & tricks.
> From now on we'll get a bit more technical. If you run into something we have not covered yet - please try checking out the [LIGO cheat sheet](api/cheat-sheet.md) for some extra tips & tricks.
To begin implementing our smart contract, we need an entry point. We'll call it `main` and it'll specify our contract's storage (`int`) and input parameter (`int`). Of course this is not the final storage/parameter of our contract, but it's something to get us started and test our LIGO installation as well.

2
gitlab-pages/website/blog/2019-06-13-public-launch-of-ligo.md
View File

@ -15,7 +15,7 @@ The core language is being developed by The Marigold Project. George Dupéron an
Our previous Medium posts about LIGO can be found [here](https://medium.com/tezos/introducing-ligo-a-new-smart-contract-language-for-tezos-233fa17f21c7) and [here](https://medium.com/tezos/ligo-becomes-polyglot-a474e2cb0c24).
## The State of LIGO
Today, we are publicly releasing LIGO in beta\*. We've focused on making the onboarding process for LIGO as painless as possible and encourage you to check out our [tutorials](/docs/tutorials/get-started/tezos-taco-shop-smart-contract) and [documentation](https://ligolang.org/docs/next/setup/installation).
Today, we are publicly releasing LIGO in beta\*. We've focused on making the onboarding process for LIGO as painless as possible and encourage you to check out our [tutorials](/docs/tutorials/get-started/tezos-taco-shop-smart-contract) and [documentation](https://ligolang.org/docs/next/intro/installation).
We are fixing bugs and adding features to LIGO (e.g. some Michelson primitives like iterators are missing) by the day. Please submit issues about bugs and missing features you need when you encounter them, and you just might find those solved in the following week.

8
gitlab-pages/website/core/Footer.js
View File

@ -28,13 +28,13 @@ class Footer extends React.Component {
<div className="sitemap">
<div>
<h5>Docs</h5>
<a href={this.docUrl('setup/installation/', this.props.language)}>
<a href={this.docUrl('next/intro/installation')}>
Installation
</a>
<a href={this.docUrl('api-cli-commands.html', this.props.language)}>
<a href={this.docUrl('next/api/cli-commands.html')}>
CLI Commands
</a>
<a href={this.docUrl('contributors/origin.html', this.props.language)}>
<a href={this.docUrl('next/contributors/origin.html')}>
Contribute
</a>
<a href="/odoc">
@ -59,7 +59,7 @@ class Footer extends React.Component {
<div>
<h5>More</h5>
<a href={`${this.props.config.baseUrl}blog`}>Blog</a>
<a href={this.docUrl('tutorials/get-started/tezos-taco-shop-smart-contract.html', this.props.language)}>Tutorials</a>
<a href={this.docUrl('tutorials/get-started/tezos-taco-shop-smart-contract.html')}>Tutorials</a>
<a href={`${this.props.config.repoUrl}`}>Gitlab</a>
</div>
</div>

2
gitlab-pages/website/pages/en/index.js
View File

@ -196,7 +196,7 @@ class HomeSplash extends React.Component {
Try Online
</LinkButton>
<LinkButton
href={docUrl("setup/installation.html")}
href={docUrl("intro/what-and-why.html")}
className="large-secondary-button"
>
Get Started

6
gitlab-pages/website/pages/en/versions.js
View File

@ -37,7 +37,7 @@ function Versions(props) {
<a
href={`${siteConfig.baseUrl}${siteConfig.docsUrl}/${
props.language ? props.language + '/' : ''
}setup/installation`}>
}intro/installation`}>
Documentation
</a>
</td>
@ -61,7 +61,7 @@ function Versions(props) {
<a
href={`${siteConfig.baseUrl}${siteConfig.docsUrl}/${
props.language ? props.language + '/' : ''
}next/setup/installation`}>
}next/intro/installation`}>
Documentation
</a>
</td>
@ -86,7 +86,7 @@ function Versions(props) {
<a
href={`${siteConfig.baseUrl}${siteConfig.docsUrl}/${
props.language ? props.language + '/' : ''
}${version}/setup/installation`}>
}${version}/intro/installation`}>
Documentation
</a>
</td>

6
gitlab-pages/website/sidebars.json
View File

@ -2,7 +2,6 @@
"docs": {
"Intro": ["intro/what-and-why", "intro/installation", "intro/editor-support"],
"Language Basics": [
"language-basics/cheat-sheet",
"language-basics/types",
"language-basics/constants-and-variables",
"language-basics/math-numbers-tez",
@ -18,7 +17,10 @@
"advanced/entrypoints-contracts",
"advanced/first-contract"
],
"API": ["api-cli-commands"]
"API": [
"api/cli-commands",
"api/cheat-sheet"
]
},
"contributors-docs": {
"Introduction": [

2
scripts/build_docker_image.sh
View File

@ -1,3 +1,3 @@
#!/bin/sh
set -e
docker build --build-arg target="4.07" -t "${LIGO_REGISTRY_IMAGE_BUILD:-ligolang/ligo}:next" -f ./docker/distribution/generic/build.Dockerfile .
docker build -t "${LIGO_REGISTRY_IMAGE_BUILD:-ligolang/ligo}:next" -f ./docker/distribution/debian/distribute.Dockerfile .

2
src/ligo.opam
View File

@ -18,6 +18,8 @@ depends: [
"yojson"
"alcotest" { with-test }
"getopt"
# work around upstream in-place update
"ocaml-migrate-parsetree" { = "1.3.1" }
]
build: [
[ "dune" "build" "-p" name "-j" jobs ]

59
src/passes/2-simplify/pascaligo.ml
View File

@ -12,6 +12,7 @@ let pseq_to_list = function
| None -> []
| Some lst -> npseq_to_list lst
let get_value : 'a Raw.reg -> 'a = fun x -> x.value
let is_compiler_generated = fun name -> String.contains name '#'
module Errors = struct
let unsupported_cst_constr p =
@ -116,17 +117,6 @@ module Errors = struct
] in
error ~data title message
let unsupported_deep_access_for_collection for_col =
let title () = "deep access in loop over collection" in
let message () =
Format.asprintf "currently, we do not support deep \
accesses in loops over collection" in
let data = [
("pattern_loc",
fun () -> Format.asprintf "%a" Location.pp_lift @@ for_col.Region.region)
] in
error ~data title message
(* Logging *)
let simplifying_instruction t =
@ -1017,6 +1007,16 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
2) Detect the free variables and build a list of their names
(myint and myst in the previous example)
Free variables are simply variables being assigned.
Note: In the case of a nested loops, assignements to a compiler
generated value (#COMPILER#acc) correspond to variables
that were already renamed in the inner loop.
e.g :
```
#COMPILER#acc.myint := #COMPILER#acc.myint + #COMPILER#elt ;
#COMPILER#acc.myst := #COMPILER#acc.myst ^ "to" ;
```
They must not be considered as free variables
3) Build the initial record (later passed as 2nd argument of
`MAP/SET/LIST_FOLD`) capturing the environment using the
@ -1030,6 +1030,10 @@ and simpl_for_int : Raw.for_int -> (_ -> expression result) result = fun fi ->
- references to the iterated value ==> variable `#COMPILER#elt_value`
in the case of a set/list:
- references to the iterated value ==> variable `#COMPILER#elt`
Note: In the case of an inner loop capturing variable from an outer loop
the free variable name can be `#COMPILER#acc.Y` and because we do not
capture the accumulator record in the inner loop, we don't want to
generate `#COMPILER#acc.#COMPILER#acc.Y` but `#COMPILER#acc.Y`
5) Append the return value to the body
@ -1063,10 +1067,8 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
(fun (prev : type_name list) (ass_exp : expression) ->
match ass_exp.expression with
| E_assign ( name , _ , _ ) ->
if (String.contains name '#') then
ok prev
else
ok (name::prev)
if is_compiler_generated name then ok prev
else ok (name::prev)
| _ -> ok prev )
[]
for_body in
@ -1077,17 +1079,18 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
(* STEP 4 *)
let replace exp =
match exp.expression with
(* replace references to fold accumulator as rhs *)
(* replace references to fold accumulator as lhs *)
| E_assign ( name , path , expr ) -> (
match path with
| [] -> ok @@ e_assign "#COMPILER#acc" [Access_record name] expr
(* This fails for deep accesses, see LIGO-131 LIGO-134 *)
| _ ->
(* ok @@ e_assign "#COMPILER#acc" ((Access_record name)::path) expr) *)
fail @@ unsupported_deep_access_for_collection fc.block )
let path' = List.filter
( fun el ->
match el with
| Access_record name -> not @@ is_compiler_generated name
| _ -> true )
((Access_record name)::path) in
ok @@ e_assign "#COMPILER#acc" path' expr)
| E_variable name -> (
if (List.mem name captured_name_list) then
(* replace references to fold accumulator as lhs *)
(* replace references to fold accumulator as rhs *)
ok @@ e_accessor (e_variable "#COMPILER#acc") [Access_record name]
else match fc.collection with
(* loop on map *)
@ -1123,16 +1126,10 @@ and simpl_for_collect : Raw.for_collect -> (_ -> expression result) result = fun
let ( arg_access: Types.access_path -> expression ) = e_accessor (e_variable "arguments") in
( match fc.collection with
| Map _ ->
(* let acc = arg_access [Access_tuple 0 ; Access_tuple 0] in
let acc = arg_access [Access_tuple 0 ] in
let collec_elt_v = arg_access [Access_tuple 1 ; Access_tuple 0] in
let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in *)
(* The above should work, but not yet (see LIGO-131) *)
let temp_kv = arg_access [Access_tuple 1] in
let acc = arg_access [Access_tuple 0] in
let collec_elt_v = e_accessor (e_variable "#COMPILER#temp_kv") [Access_tuple 0] in
let collec_elt_k = e_accessor (e_variable "#COMPILER#temp_kv") [Access_tuple 1] in
let collec_elt_k = arg_access [Access_tuple 1 ; Access_tuple 1] in
e_let_in ("#COMPILER#acc", None) acc @@
e_let_in ("#COMPILER#temp_kv", None) temp_kv @@
e_let_in ("#COMPILER#collec_elt_k", None) collec_elt_v @@
e_let_in ("#COMPILER#collec_elt_v", None) collec_elt_k (for_body)
| _ ->

52
src/passes/3-self_ast_simplified/helpers.ml
View File

@ -8,26 +8,25 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
match e.expression with
| E_literal _ | E_variable _ | E_skip -> ok init'
| E_list lst | E_set lst | E_tuple lst | E_constant (_ , lst) -> (
let%bind res' = bind_fold_list self init' lst in
ok res'
let%bind res = bind_fold_list self init' lst in
ok res
)
| E_map lst | E_big_map lst -> (
let%bind res' = bind_fold_list (bind_fold_pair self) init' lst in
ok res'
let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
ok res
)
| E_look_up ab | E_sequence ab | E_loop ab | E_application ab -> (
let%bind res' = bind_fold_pair self init' ab in
ok res'
let%bind res = bind_fold_pair self init' ab in
ok res
)
| E_lambda { binder = _ ; input_type = _ ; output_type = _ ; result = e }
| E_annotation (e , _) | E_constructor (_ , e) -> (
let%bind res' = self init' e in
ok res'
let%bind res = self init' e in
ok res
)
| E_assign (_ , path , e) | E_accessor (e , path) -> (
let%bind res' = fold_path f init' path in
let%bind res' = self res' e in
ok res'
| E_assign (_ , _path , e) | E_accessor (e , _path) -> (
let%bind res = self init' e in
ok res
)
| E_matching (e , cases) -> (
let%bind res = self init' e in
@ -36,8 +35,8 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
)
| E_record m -> (
let aux init'' _ expr =
let%bind res' = fold_expression self init'' expr in
ok res'
let%bind res = fold_expression self init'' expr in
ok res
in
let%bind res = bind_fold_smap aux (ok init') m in
ok res
@ -48,16 +47,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
ok res
)
and fold_path : 'a folder -> 'a -> access_path -> 'a result = fun f init p -> bind_fold_list (fold_access f) init p
and fold_access : 'a folder -> 'a -> access -> 'a result = fun f init a ->
match a with
| Access_map e -> (
let%bind e' = fold_expression f init e in
ok e'
)
| _ -> ok init
and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
match m with
| Match_bool { match_true ; match_false } -> (
@ -127,8 +116,7 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
)
| E_assign (name , path , e) -> (
let%bind e' = self e in
let%bind path' = map_path f path in
return @@ E_assign (name , path' , e')
return @@ E_assign (name , path , e')
)
| E_matching (e , cases) -> (
let%bind e' = self e in
@ -137,8 +125,7 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
)
| E_accessor (e , path) -> (
let%bind e' = self e in
let%bind path' = map_path f path in
return @@ E_accessor (e' , path')
return @@ E_accessor (e' , path)
)
| E_record m -> (
let%bind m' = bind_map_smap self m in
@ -171,15 +158,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
)
| E_literal _ | E_variable _ | E_skip as e' -> return e'
and map_path : mapper -> access_path -> access_path result = fun f p -> bind_map_list (map_access f) p
and map_access : mapper -> access -> access result = fun f a ->
match a with
| Access_map e -> (
let%bind e' = map_expression f e in
ok @@ Access_map e'
)
| a -> ok a
and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
match m with

15
src/passes/4-typer-new/solver.ml
View File

@ -150,7 +150,6 @@ module Wrap = struct
(* let t_literal_t = t *)
let t_literal_bool = bool
let t_literal_string = string
let t_access_map = forall2 "k" "v" @@ fun k v -> map k v --> k --> v
let t_application = forall2 "a" "b" @@ fun a b -> (a --> b) --> a --> b
let t_look_up = forall2 "ind" "v" @@ fun ind v -> map ind v --> ind --> option v
let t_sequence = forall "b" @@ fun b -> unit --> b --> b
@ -166,20 +165,6 @@ module Wrap = struct
let access_int ~base ~index = access_label ~base ~label:(L_int index)
let access_string ~base ~property = access_label ~base ~label:(L_string property)
let access_map : base:T.type_value -> key:T.type_value -> (constraints * T.type_name) =
let mk_map_type key_type element_type =
O.P_constant O.(C_map , [P_variable element_type; P_variable key_type]) in
fun ~base ~key ->
let key_type = Core.fresh_type_variable () in
let element_type = Core.fresh_type_variable () in
let base' = type_expression_to_type_value base in
let key' = type_expression_to_type_value key in
let base_expected = mk_map_type key_type element_type in
let expr_type = Core.fresh_type_variable () in
O.[C_equation (base' , base_expected);
C_equation (key' , P_variable key_type);
C_equation (P_variable expr_type , P_variable element_type)] , Type_name expr_type
let constructor
: T.type_value -> T.type_value -> T.type_value -> (constraints * T.type_name)
= fun t_arg c_arg sum ->

19
src/passes/4-typer-new/typer.ml
View File

@ -191,15 +191,6 @@ module Errors = struct
] in
error ~data title message ()
let not_supported_yet (message : string) (ae : I.expression) () =
let title = (thunk "not supported yet") in
let message () = message in
let data = [
("expression" , fun () -> Format.asprintf "%a" I.PP.expression ae) ;
("location" , fun () -> Format.asprintf "%a" Location.pp ae.location)
] in
error ~data title message ()
let not_supported_yet_untranspile (message : string) (ae : O.expression) () =
let title = (thunk "not supported yet") in
let message () = message in
@ -491,14 +482,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e
let wrapped = Wrap.access_string ~base:base'.type_annotation ~property in
return_wrapped (E_record_accessor (base' , property)) state' wrapped
)
| E_accessor (base , [Access_map key_ae]) -> (
let%bind (base' , state') = type_expression e state base in
let%bind (key_ae' , state'') = type_expression e state' key_ae in
let xyz = get_type_annotation key_ae' in
let wrapped = Wrap.access_map ~base:base'.type_annotation ~key:xyz in
return_wrapped (E_look_up (base' , key_ae')) state'' wrapped
)
| E_accessor (_base , []) | E_accessor (_base , _ :: _ :: _) -> (
failwith
"The simplifier should produce E_accessor with only a single path element, not a list of path elements."
@ -791,8 +774,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e
Map.String.find_opt property m in
ok (tv' , prec_path @ [O.Access_record property])
)
| Access_map _ ->
fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae
in
bind_fold_list aux (typed_name.type_value , []) path in
let%bind (expr' , state') = type_expression e state expr in

9
src/passes/4-typer-new/typer.ml.old
View File

@ -449,13 +449,6 @@ and type_expression : environment -> ?tv_opt:O.type_expression -> I.expression -
@@ (fun () -> SMap.find property r_tv) in
return (E_record_accessor (prev , property)) tv
)
| Access_map ae' -> (
let%bind ae'' = type_expression e ae' in
let%bind (k , v) = get_t_map prev.type_annotation in
let%bind () =
Ast_typed.assert_type_expression_eq (k , get_type_annotation ae'') in
return (E_look_up (prev , ae'')) v
)
in
trace (simple_info "accessing") @@
bind_fold_list aux e' path
@ -725,8 +718,6 @@ and type_expression : environment -> ?tv_opt:O.type_expression -> I.expression -
Map.String.find_opt property m in
ok (tv' , prec_path @ [O.Access_record property])
)
| Access_map _ ->
fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae
in
bind_fold_list aux (typed_name.type_expression , []) path in
let%bind expr' = type_expression e expr in

35
src/passes/4-typer-old/typer.ml
View File

@ -191,15 +191,6 @@ module Errors = struct
] in
error ~data title message ()
let not_supported_yet (message : string) (ae : I.expression) () =
let title = (thunk "not suported yet") in
let message () = message in
let data = [
("expression" , fun () -> Format.asprintf "%a" I.PP.expression ae) ;
("location" , fun () -> Format.asprintf "%a" Location.pp ae.location)
] in
error ~data title message ()
let not_supported_yet_untranspile (message : string) (ae : O.expression) () =
let title = (thunk "not suported yet") in
let message () = message in
@ -441,25 +432,29 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
let%bind tv =
generic_try (bad_tuple_index index ae' prev.type_annotation ae.location)
@@ (fun () -> List.nth tpl_tv index) in
return (E_tuple_accessor (prev , index)) tv
let location = ae.location in
ok @@ make_a_e ~location (E_tuple_accessor(prev , index)) tv e
)
| Access_record property -> (
let%bind r_tv = get_t_record prev.type_annotation in
let%bind tv =
generic_try (bad_record_access property ae' prev.type_annotation ae.location)
@@ (fun () -> SMap.find property r_tv) in
return (E_record_accessor (prev , property)) tv
)
| Access_map ae' -> (
let%bind ae'' = type_expression' e ae' in
let%bind (k , v) = bind_map_or (get_t_map , get_t_big_map) prev.type_annotation in
let%bind () =
Ast_typed.assert_type_value_eq (k , get_type_annotation ae'') in
return (E_look_up (prev , ae'')) v
let location = ae.location in
ok @@ make_a_e ~location (E_record_accessor (prev , property)) tv e
)
in
let%bind ae =
trace (simple_info "accessing") @@
bind_fold_list aux e' path
bind_fold_list aux e' path in
(* check type annotation of the final accessed element *)
let%bind () =
match tv_opt with
| None -> ok ()
| Some tv' -> O.assert_type_value_eq (tv' , ae.type_annotation) in
ok(ae)
(* Sum *)
| E_constructor (c, expr) ->
let%bind (c_tv, sum_tv) =
@ -758,8 +753,6 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
Map.String.find_opt property m in
ok (tv' , prec_path @ [O.Access_record property])
)
| Access_map _ ->
fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae
in
bind_fold_list aux (typed_name.type_value , []) path in
let%bind expr' = type_expression' e ~tv_opt:assign_tv expr in

1
src/passes/6-transpiler/transpiler.ml
View File

@ -510,7 +510,6 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
(Map.String.find_opt prop ty_map) in
ok (prop_in_ty_map, acc @ path')
)
| Access_map _k -> fail (corner_case ~loc:__LOC__ "no patch for map yet")
in
let%bind (_, path) = bind_fold_right_list aux (ty, []) path in
let%bind expr' = transpile_annotated_expression expr in

62
src/passes/7-self_mini_c/self_mini_c.ml
View File

@ -1,14 +1,62 @@
open Mini_c
open Trace
(* Overly conservative for now: ok to treat pure things as impure,
(* Overly conservative purity test: ok to treat pure things as impure,
must not treat impure things as pure. *)
let is_pure : expression -> bool = fun e ->
match e.content with
| E_closure _ -> true
(* true if the name names a pure constant -- i.e. if uses will be pure
assuming arguments are pure *)
let is_pure_constant : string -> bool =
function
| "CAR"
| "CDR"
| "PAIR"
-> true
(* TODO... *)
| _ -> false
let rec elim_dead_lambdas : expression -> expression result = fun e ->
let rec is_pure : expression -> bool = fun e ->
match e.content with
| E_literal _
| E_closure _
| E_skip
| E_variable _
| E_make_empty_map _
| E_make_empty_list _
| E_make_empty_set _
| E_make_none _
-> true
| E_if_bool (cond, bt, bf)
| E_if_none (cond, bt, (_, bf))
| E_if_cons (cond, bt, (_, bf))
| E_if_left (cond, (_, bt), (_, bf))
-> List.for_all is_pure [ cond ; bt ; bf ]
| E_let_in (_, e1, e2)
| E_sequence (e1, e2)
-> List.for_all is_pure [ e1 ; e2 ]
| E_constant (c, args)
-> is_pure_constant c && List.for_all is_pure args
(* I'm not sure about these. Maybe can be tested better? *)
| E_application _
| E_iterator _
| E_fold _
-> false
(* Could be pure, but, divergence is an effect, so halting problem
is near... *)
| E_while _ -> false
(* definitely not pure *)
| E_assignment _ -> false
(* Eliminate dead `let` with pure rhs *)
let rec elim_dead_code : expression -> expression result = fun e ->
let changed = ref false in (* ugh *)
let mapper : Helpers.mapper = fun e ->
match e.content with
@ -22,8 +70,8 @@ let rec elim_dead_lambdas : expression -> expression result = fun e ->
| _ -> ok e in
let%bind e = Helpers.map_expression mapper e in
if !changed
then elim_dead_lambdas e
then elim_dead_code e
else ok e
let all_expression : expression -> expression result =
elim_dead_lambdas
elim_dead_code

1
src/passes/operators/operators.ml
View File

@ -64,6 +64,7 @@ module Simplify = struct
("int" , "INT") ;
("abs" , "ABS") ;
("amount" , "AMOUNT") ;
("balance", "BALANCE") ;
("now" , "NOW") ;
("unit" , "UNIT") ;
("source" , "SOURCE") ;

1
src/stages/ast_simplified/PP.ml
View File

@ -82,7 +82,6 @@ and access ppf (a:access) =
match a with
| Access_tuple n -> fprintf ppf "%d" n
| Access_record s -> fprintf ppf "%s" s
| Access_map s -> fprintf ppf "(%a)" expression s
and access_path ppf (p:access_path) =
fprintf ppf "%a" (list_sep access (const ".")) p

3
src/stages/ast_simplified/combinators.ml
View File

@ -148,8 +148,7 @@ let assert_e_accessor = fun t ->
let get_access_record : access -> string result = fun a ->
match a with
| Access_tuple _
| Access_map _ -> simple_fail "not an access record"
| Access_tuple _ -> simple_fail "not an access record"
| Access_record s -> ok s
let get_e_pair = fun t ->

2
src/stages/ast_simplified/types.ml
View File

@ -56,6 +56,7 @@ and expression' =
| E_constructor of (name * expr) (* For user defined constructors *)
(* E_record *)
| E_record of expr_map
(* TODO: Change it to (expr * access) *)
| E_accessor of (expr * access_path)
(* Data Structures *)
| E_map of (expr * expr) list
@ -81,7 +82,6 @@ and expression = {
and access =
| Access_tuple of int
| Access_record of string
| Access_map of expr
and access_path = access list

1
src/stages/ast_typed/PP.ml
View File

@ -98,7 +98,6 @@ and matching : type a . (formatter -> a -> unit) -> _ -> a matching -> unit = fu
and pre_access ppf (a:access) = match a with
| Access_record n -> fprintf ppf ".%s" n
| Access_tuple i -> fprintf ppf ".%d" i
| Access_map n -> fprintf ppf ".%a" annotated_expression n
let declaration ppf (d:declaration) =
match d with

1
src/stages/ast_typed/types.ml
View File

@ -131,7 +131,6 @@ and literal =
and access =
| Access_tuple of int
| Access_record of string
| Access_map of ae
and access_path = access list

5
src/stages/mini_c/misc.ml
View File

@ -75,9 +75,8 @@ module Free_variables = struct
expression (union (singleton v) b) body ;
]
| E_sequence (x, y) -> union (self x) (self y)
(* we do not consider the assigned variable free... seems strange,
but, matches ast_typed, and does not cause any troubles? *)
| E_assignment (_, _, e) -> self e
(* NB different from ast_typed... *)
| E_assignment (v, _, e) -> unions [ var_name b v ; self e ]
| E_while (cond , body) -> union (self cond) (self body)
and var_name : bindings -> var_name -> bindings = fun b n ->

11
src/test/contracts/balance_constant.ligo Normal file
View File

@ -0,0 +1,11 @@
(**
This test makes sure that the balance is accessible in PascaLIGO.
It's there to detect a regression of: https://gitlab.com/ligolang/ligo/issues/68
*)
type storage is tez
function main (const p : unit; const s: int) : list(operation) * storage is
((nil : list(operation)), balance)

22
src/test/contracts/deep_access.ligo Normal file
View File

@ -0,0 +1,22 @@
//Test deep_access in PascalLigo
type pii is (int*int)
type ppi is record x:pii; y:pii end
type ppp is (ppi*ppi)
function main (const toto : unit) : int is
var a : ppp :=
(
record
x = (0,1);
y = (10,11);
end
,
record
x = (100,101);
y = (110,111);
end
)
begin
a.0.x.0 := 2;
const b:int = a.0.x.0;
end with b

34
src/test/contracts/loop.ligo
View File

@ -134,20 +134,26 @@ function for_collection_map_k (var nee : unit) : string is block {
end
} with st
// function nested_for_collection (var nee : unit) : (int*string) is block {
// var myint : int := 0;
// var myst : string := "";
// var mylist : list(int) := list 1 ; 2 ; 3 end ;
// for i : int in list mylist
// begin
// myint := myint + i ;
// var myset : set(string) := set "1" ; "2" ; "3" end ;
// for st : string in set myset
// begin
// myst := myst ^ st ;
// end
// end
// } with (myint,myst)
function nested_for_collection (var nee : unit) : (int*string) is block {
var myint : int := 0;
var mystoo : string := "";
var mylist : list(int) := list 1 ; 2 ; 3 end ;
var mymap : map(string,string) := map " one" -> "," ; "two" -> " " end ;
for i in list mylist
begin
myint := myint + i ;
var myset : set(string) := set "1" ; "2" ; "3" end ;
for st in set myset
begin
mystoo := mystoo ^ st ;
for k -> v in map mymap
begin
mystoo := mystoo ^ k ^ v ;
end
end
end
} with (myint,mystoo)
function dummy (const n : nat) : nat is block {
while False block { skip }

21
src/test/contracts/simple_access.ligo Normal file
View File

@ -0,0 +1,21 @@
//Test simple_access in PascalLigo
type tpi is (int*int)
type rpi is record
x : int;
y : int;
end
type mpi is map(string,int)
function main (const toto : tpi) : int is
var a : tpi := toto;
var b : rpi := record x = 0; y=1 ; end;
var m : mpi := map "y" -> 1; end;
begin
a.0 := 2;
b.x := a.0;
m["x"] := b.x;
end with
case m["x"] of
| Some (s) -> s
| None -> 42
end

30
src/test/integration_tests.ml
View File

@ -825,9 +825,10 @@ let loop () : unit result =
let%bind () =
let expected = (e_int 20) in
expect_eq program "for_collection_comp_with_acc" input expected in
(* let%bind () =
let expected = e_pair (e_int 6) (e_string "123123123") in
expect_eq program "nested_for_collection" input expected in *)
let%bind () =
let expected = e_pair (e_int 6)
(e_string "1 one,two 2 one,two 3 one,two 1 one,two 2 one,two 3 one,two 1 one,two 2 one,two 3 one,two ") in
expect_eq program "nested_for_collection" input expected in
let%bind () =
let ez lst =
let open Ast_simplified.Combinators in
@ -1164,10 +1165,28 @@ let website2_mligo () : unit result =
expect_eq_n program "main" make_input make_expected
let balance_constant () : unit result =
let%bind program = type_file "./contracts/balance_constant.ligo" in
let input = e_tuple [e_unit () ; e_mutez 0] in
let expected = e_tuple [e_list []; e_mutez 4000000000000] in
expect_eq program "main" input expected
let balance_constant_mligo () : unit result =
let%bind program = mtype_file "./contracts/balance_constant.mligo" in
let input = e_tuple [e_unit () ; e_mutez 0] in
let expected = e_tuple [e_list []; e_mutez 4000000000000] in
expect_eq program "main" input expected
let simple_access_ligo () : unit result =
let%bind program = type_file "./contracts/simple_access.ligo" in
let make_input = e_tuple [e_int 0; e_int 1] in
let make_expected = e_int 2 in
expect_eq program "main" make_input make_expected
let deep_access_ligo () : unit result =
let%bind program = type_file "./contracts/deep_access.ligo" in
let make_input = e_unit () in
let make_expected = e_int 2 in
expect_eq program "main" make_input make_expected
let main = test_suite "Integration (End to End)" [
test "type alias" type_alias ;
@ -1250,5 +1269,8 @@ let main = test_suite "Integration (End to End)" [
test "website1 ligo" website1_ligo ;
test "website2 ligo" website2_ligo ;
test "website2 (mligo)" website2_mligo ;
test "balance constant (mligo)" balance_constant ;
test "balance constant" balance_constant ;
test "balance constant (mligo)" balance_constant_mligo ;
test "simple_access (ligo)" simple_access_ligo;
test "deep_access (ligo)" deep_access_ligo;
]