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

Merge branch 'feature/adt-generator-poly-3' into 'dev'

Browse Source 
ADT generator: support polymorphic types ('a list, 'a option) + remove auto-generated file + debug that

See merge request ligolang/ligo!403
This commit is contained in:
Suzanne Dupéron 2020-02-10 20:42:04 +00:00
commit ae8913fa8d
20 changed files with 103 additions and 254 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
docker/distribution/generic/build.Dockerfile
View File

@ -29,7 +29,7 @@ RUN opam update
# Install ligo
RUN sh scripts/install_vendors_deps.sh
RUN opam install -y .
RUN opam install -y . || (tail -n +1 ~/.opam/log/* ; false)
# Use the ligo binary as a default command
ENTRYPOINT [ "/home/opam/.opam/4.07/bin/ligo" ]

1
scripts/build_docker_image.sh
View File

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

1
scripts/build_ligo_local.sh
View File

@ -1,5 +1,6 @@
#!/bin/sh
set -e
set -x
eval $(opam config env)
dune build -p ligo

2
scripts/distribution/generic/build.sh
View File

@ -1,4 +1,6 @@
#!/bin/sh
set -e
set -x
dockerfile_name="build"
# Generic dockerfile

2
scripts/distribution/generic/package.sh
View File

@ -1,4 +1,6 @@
#!/bin/sh
set -e
set -x
dockerfile_name="package"
dockerfile=""

10
scripts/distribution/generic/parameters.sh
View File

@ -1,11 +1,15 @@
#!/bin/sh
set -e
set -x
# This script accepts three arguments, os family, os and its version,
# which are subsequently used to fetch the respective docker
# image from the ocaml/infrastructure project.
#
# https://github.com/ocaml/infrastructure/wiki/Containers#selecting-linux-distributions
target_os_family=$1
target_os=$2
target_os_version=$3
target_os_family="$1"
target_os="$2"
target_os_version="$3"
# Variables configured at the CI level
dist="$LIGO_DIST_DIR"

3
scripts/install_build_environment.sh
View File

@ -22,6 +22,7 @@ echo "Installing dependencies.."
if [ -n "`uname -a | grep -i arch`" ]
then
sudo pacman -Sy --noconfirm \
python \
make \
m4 \
gcc \
@ -34,6 +35,8 @@ fi
if [ -n "`uname -a | grep -i ubuntu`" ]
then
sudo apt-get install -y make \
python3 \
make \
m4 \
gcc \
patch \

3
scripts/install_native_dependencies.sh
View File

@ -1,11 +1,13 @@
#!/bin/sh
set -e
set -x
. /etc/os-release
if [ $ID = arch ]
then
pacman -Sy
sudo pacman -S --noconfirm \
python \
libevdev \
perl \
pkg-config \
@ -20,6 +22,7 @@ then
else
apt-get update -qq
apt-get -y -qq install \
python3 \
libev-dev \
perl \
pkg-config \

1
scripts/install_vendors_deps.sh
View File

@ -1,5 +1,6 @@
#!/bin/sh
set -e
set -x
# Install local dependencies
opam install -y --deps-only --with-test ./ligo.opam $(find vendors -name \*.opam)

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

@ -649,7 +649,6 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
let wtype = Format.asprintf
"Loops over collections expect lists, sets or maps, got type %a" O.PP.type_expression tv_col in
fail @@ simple_error wtype in
let lname = lname in
let e' = Environment.add_ez_binder lname input_type e in
let%bind body = type_expression' ?tv_opt:(Some tv_out) e' result in
let output_type = body.type_expression in

2
src/stages/adt_generator/.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
# This is an auto-generated test file
/generated_fold.ml

4
src/stages/adt_generator/README
View File

@ -1,6 +1,6 @@
Build with:
Build & test with:
dune build adt_generator.a
dune build adt_generator.exe && ../../../_build/default/src/stages/adt_generator/adt_generator.exe
Run with

21
src/stages/adt_generator/a.ml
View File

@ -1,6 +1,6 @@
type root =
| A of a
| B of int
| A of rootA
| B of rootB
| C of string
and a = {
@ -15,3 +15,20 @@ and ta1 =
and ta2 =
| Z of ta2
| W of unit
and rootA =
a list
and rootB =
int list
let fold_list v state continue =
let aux = fun (lst', state) elt ->
let (elt', state) = continue elt state in
(elt' :: lst' , state) in
List.fold_left aux ([], state) v
let fold_option v state continue =
match v with
Some x -> continue x state
| None -> None

12
src/stages/adt_generator/dune
View File

@ -1,8 +1,9 @@
(rule
(target fold.ml)
(target generated_fold.ml)
(deps generator.py)
(action (with-stdout-to fold.ml (run python3 ./generator.py)))
(mode (promote (until-clean))))
(action (with-stdout-to generated_fold.ml (run python3 ./generator.py)))
; (mode (promote (until-clean))) ; If this is uncommented, then "dune build -p ligo" can't find the file (but "dune build" can)
)
; (library
; (name adt_generator)
; (public_name ligo.adt_generator)
@ -16,3 +17,8 @@
(libraries
)
)
(alias
(name runtest)
(action (run ./adt_generator.exe))
)

185
src/stages/adt_generator/fold.ml
View File

@ -1,184 +1 @@
open A
type root' =
| A' of a'
| B' of int
| C' of string
and a' =
{
a1' : ta1' ;
a2' : ta2' ;
}
and ta1' =
| X' of root'
| Y' of ta2'
and ta2' =
| Z' of ta2'
| W' of unit
type 'state continue_fold =
{
root : root -> 'state -> (root' * 'state) ;
root_A : a -> 'state -> (a' * 'state) ;
root_B : int -> 'state -> (int * 'state) ;
root_C : string -> 'state -> (string * 'state) ;
a : a -> 'state -> (a' * 'state) ;
a_a1 : ta1 -> 'state -> (ta1' * 'state) ;
a_a2 : ta2 -> 'state -> (ta2' * 'state) ;
ta1 : ta1 -> 'state -> (ta1' * 'state) ;
ta1_X : root -> 'state -> (root' * 'state) ;
ta1_Y : ta2 -> 'state -> (ta2' * 'state) ;
ta2 : ta2 -> 'state -> (ta2' * 'state) ;
ta2_Z : ta2 -> 'state -> (ta2' * 'state) ;
ta2_W : unit -> 'state -> (unit * 'state) ;
}
type 'state fold_config =
{
root : root -> 'state -> ('state continue_fold) -> (root' * 'state) ;
root_pre_state : root -> 'state -> 'state ;
root_post_state : root -> root' -> 'state -> 'state ;
root_A : a -> 'state -> ('state continue_fold) -> (a' * 'state) ;
root_B : int -> 'state -> ('state continue_fold) -> (int * 'state) ;
root_C : string -> 'state -> ('state continue_fold) -> (string * 'state) ;
a : a -> 'state -> ('state continue_fold) -> (a' * 'state) ;
a_pre_state : a -> 'state -> 'state ;
a_post_state : a -> a' -> 'state -> 'state ;
a_a1 : ta1 -> 'state -> ('state continue_fold) -> (ta1' * 'state) ;
a_a2 : ta2 -> 'state -> ('state continue_fold) -> (ta2' * 'state) ;
ta1 : ta1 -> 'state -> ('state continue_fold) -> (ta1' * 'state) ;
ta1_pre_state : ta1 -> 'state -> 'state ;
ta1_post_state : ta1 -> ta1' -> 'state -> 'state ;
ta1_X : root -> 'state -> ('state continue_fold) -> (root' * 'state) ;
ta1_Y : ta2 -> 'state -> ('state continue_fold) -> (ta2' * 'state) ;
ta2 : ta2 -> 'state -> ('state continue_fold) -> (ta2' * 'state) ;
ta2_pre_state : ta2 -> 'state -> 'state ;
ta2_post_state : ta2 -> ta2' -> 'state -> 'state ;
ta2_Z : ta2 -> 'state -> ('state continue_fold) -> (ta2' * 'state) ;
ta2_W : unit -> 'state -> ('state continue_fold) -> (unit * 'state) ;
}
(* Curries the "visitor" argument to the folds (non-customizable traversal functions). *)
let rec mk_continue_fold : type state . state fold_config -> state continue_fold = fun visitor ->
{
root = fold_root visitor ;
root_A = fold_root_A visitor ;
root_B = fold_root_B visitor ;
root_C = fold_root_C visitor ;
a = fold_a visitor ;
a_a1 = fold_a_a1 visitor ;
a_a2 = fold_a_a2 visitor ;
ta1 = fold_ta1 visitor ;
ta1_X = fold_ta1_X visitor ;
ta1_Y = fold_ta1_Y visitor ;
ta2 = fold_ta2 visitor ;
ta2_Z = fold_ta2_Z visitor ;
ta2_W = fold_ta2_W visitor ;
}
and fold_root : type state . state fold_config -> root -> state -> (root' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
let state = visitor.root_pre_state x state in
let (new_x, state) = visitor.root x state continue_fold in
let state = visitor.root_post_state x new_x state in
(new_x, state)
and fold_root_A : type state . state fold_config -> a -> state -> (a' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
visitor.root_A x state continue_fold
and fold_root_B : type state . state fold_config -> int -> state -> (int * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
visitor.root_B x state continue_fold
and fold_root_C : type state . state fold_config -> string -> state -> (string * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
visitor.root_C x state continue_fold
and fold_a : type state . state fold_config -> a -> state -> (a' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
let state = visitor.a_pre_state x state in
let (new_x, state) = visitor.a x state continue_fold in
let state = visitor.a_post_state x new_x state in
(new_x, state)
and fold_a_a1 : type state . state fold_config -> ta1 -> state -> (ta1' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
visitor.a_a1 x state continue_fold
and fold_a_a2 : type state . state fold_config -> ta2 -> state -> (ta2' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
visitor.a_a2 x state continue_fold
and fold_ta1 : type state . state fold_config -> ta1 -> state -> (ta1' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
let state = visitor.ta1_pre_state x state in
let (new_x, state) = visitor.ta1 x state continue_fold in
let state = visitor.ta1_post_state x new_x state in
(new_x, state)
and fold_ta1_X : type state . state fold_config -> root -> state -> (root' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
visitor.ta1_X x state continue_fold
and fold_ta1_Y : type state . state fold_config -> ta2 -> state -> (ta2' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
visitor.ta1_Y x state continue_fold
and fold_ta2 : type state . state fold_config -> ta2 -> state -> (ta2' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
let state = visitor.ta2_pre_state x state in
let (new_x, state) = visitor.ta2 x state continue_fold in
let state = visitor.ta2_post_state x new_x state in
(new_x, state)
and fold_ta2_Z : type state . state fold_config -> ta2 -> state -> (ta2' * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
visitor.ta2_Z x state continue_fold
and fold_ta2_W : type state . state fold_config -> unit -> state -> (unit * state) = fun visitor x state ->
let continue_fold : state continue_fold = mk_continue_fold visitor in
visitor.ta2_W x state continue_fold
let no_op : 'a fold_config = {
root = (fun v state continue ->
match v with
| A v -> let (v, state) = continue.root_A v state in (A' v, state)
| B v -> let (v, state) = continue.root_B v state in (B' v, state)
| C v -> let (v, state) = continue.root_C v state in (C' v, state)
);
root_pre_state = (fun v state -> ignore v; state) ;
root_post_state = (fun v new_v state -> ignore (v, new_v); state) ;
root_A = (fun v state continue -> continue.a v state ) ;
root_B = (fun v state continue -> ignore continue; (v, state) ) ;
root_C = (fun v state continue -> ignore continue; (v, state) ) ;
a = (fun v state continue ->
match v with
{ a1; a2; } ->
let (a1', state) = continue.a_a1 a1 state in
let (a2', state) = continue.a_a2 a2 state in
({ a1'; a2'; }, state)
);
a_pre_state = (fun v state -> ignore v; state) ;
a_post_state = (fun v new_v state -> ignore (v, new_v); state) ;
a_a1 = (fun v state continue -> continue.ta1 v state ) ;
a_a2 = (fun v state continue -> continue.ta2 v state ) ;
ta1 = (fun v state continue ->
match v with
| X v -> let (v, state) = continue.ta1_X v state in (X' v, state)
| Y v -> let (v, state) = continue.ta1_Y v state in (Y' v, state)
);
ta1_pre_state = (fun v state -> ignore v; state) ;
ta1_post_state = (fun v new_v state -> ignore (v, new_v); state) ;
ta1_X = (fun v state continue -> continue.root v state ) ;
ta1_Y = (fun v state continue -> continue.ta2 v state ) ;
ta2 = (fun v state continue ->
match v with
| Z v -> let (v, state) = continue.ta2_Z v state in (Z' v, state)
| W v -> let (v, state) = continue.ta2_W v state in (W' v, state)
);
ta2_pre_state = (fun v state -> ignore v; state) ;
ta2_post_state = (fun v new_v state -> ignore (v, new_v); state) ;
ta2_Z = (fun v state continue -> continue.ta2 v state ) ;
ta2_W = (fun v state continue -> ignore continue; (v, state) ) ;
}
include Generated_fold

58
src/stages/adt_generator/generator.py
View File

@ -1,34 +1,49 @@
moduleName = "A"
variant="_ _variant"
record="_ _record"
def poly(x): return x
adts = [
# typename, variant?, fields_or_ctors
("root", True, [
# ctor, builtin, type
("A", False, "a"),
("B", True, "int"),
# typename, kind, fields_or_ctors
("root", variant, [
# ctor, builtin?, type
("A", False, "rootA"),
("B", False, "rootB"),
("C", True, "string"),
]),
("a", False, [
("a", record, [
# field, builtin?, type
("a1", False, "ta1"),
("a2", False, "ta2"),
]),
("ta1", True, [
("ta1", variant, [
("X", False, "root"),
("Y", False, "ta2"),
]),
("ta2", True, [
("ta2", variant, [
("Z", False, "ta2"),
("W", True, "unit"),
]),
# polymorphic type
("rootA", poly("list"),
[
# Position (0..n-1), builtin?, type argument
(0, False, "a")
]),
("rootB", poly("list"),
[
# Position (0..n-1), builtin?, type argument
(0, True, "int")
]),
]
from collections import namedtuple
adt = namedtuple('adt', ['name', 'newName', 'isVariant', 'ctorsOrFields'])
adt = namedtuple('adt', ['name', 'newName', 'kind', 'ctorsOrFields'])
ctorOrField = namedtuple('ctorOrField', ['name', 'newName', 'isBuiltin', 'type_', 'newType'])
adts = [
adt(
name = name,
newName = f"{name}'",
isVariant = isVariant,
kind = kind,
ctorsOrFields = [
ctorOrField(
name = cf,
@ -40,23 +55,32 @@ adts = [
for (cf, isBuiltin, type_) in ctors
],
)
for (name, isVariant, ctors) in adts
for (name, kind, ctors) in adts
]
print("(* This is an auto-generated file. Do not edit. *)")
print("")
print("open %s" % moduleName)
print("")
for (index, t) in enumerate(adts):
typeOrAnd = "type" if index == 0 else "and"
print(f"{typeOrAnd} {t.newName} =")
if t.isVariant:
if t.kind == variant:
for c in t.ctorsOrFields:
print(f" | {c.newName} of {c.newType}")
else:
elif t.kind == record:
print(" {")
for f in t.ctorsOrFields:
print(f" {f.newName} : {f.newType} ;")
print(" }")
else:
print(" ", end='')
for a in t.ctorsOrFields:
print(f"{a.newType}", end=' ')
print(t.kind, end='')
print("")
print("")
print(f"type 'state continue_fold =")
@ -107,10 +131,10 @@ print("let no_op : 'a fold_config = {")
for t in adts:
print(f" {t.name} = (fun v state continue ->")
print(" match v with")
if t.isVariant:
if t.kind == variant:
for c in t.ctorsOrFields:
print(f" | {c.name} v -> let (v, state) = continue.{t.name}_{c.name} v state in ({c.newName} v, state)")
else:
elif t.kind == record:
print(" {", end=' ')
for f in t.ctorsOrFields:
print(f"{f.name};", end=' ')
@ -121,6 +145,10 @@ for t in adts:
for f in t.ctorsOrFields:
print(f"{f.newName};", end=' ')
print("}, state)")
else:
print(f" v -> fold_{t.kind} v state (", end=' ')
print(", ".join([f"continue.{t.name}_{f.name}" for f in t.ctorsOrFields]), end='')
print(" )")
print(" );")
print(f" {t.name}_pre_state = (fun v state -> ignore v; state) ;")
print(f" {t.name}_post_state = (fun v new_v state -> ignore (v, new_v); state) ;")

6
src/stages/adt_generator/use_a_fold.ml
View File

@ -4,7 +4,7 @@ open Fold
(* TODO: how should we plug these into our test framework? *)
let () =
let some_root : root = A { a1 = X (A { a1 = X (B 1) ; a2 = W () ; }) ; a2 = Z (W ()) ; } in
let some_root : root = A [{ a1 = X (A [{ a1 = X (B [1;2;3]) ; a2 = W () ; }]) ; a2 = Z (W ()) ; }] in
let op = {
no_op with
a = fun the_a state continue_fold ->
@ -23,7 +23,7 @@ let () =
()
let () =
let some_root : root = A { a1 = X (A { a1 = X (B 1) ; a2 = W () ; }) ; a2 = Z (W ()) ; } in
let some_root : root = A [{ a1 = X (A [{ a1 = X (B [1;2;3]) ; a2 = W () ; }]) ; a2 = Z (W ()) ; }] in
let op = { no_op with a_pre_state = fun _the_a state -> state + 1 } in
let state = 0 in
let (_, state) = fold_root op some_root state in
@ -33,7 +33,7 @@ let () =
()
let () =
let some_root : root = A { a1 = X (A { a1 = X (B 1) ; a2 = W () ; }) ; a2 = Z (W ()) ; } in
let some_root : root = A [{ a1 = X (A [{ a1 = X (B [1;2;3]) ; a2 = W () ; }]) ; a2 = Z (W ()) ; }] in
let op = { no_op with a_post_state = fun _the_a _new_a state -> state + 1 } in
let state = 0 in
let (_, state) = fold_root op some_root state in

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

@ -95,7 +95,6 @@ and matching =
and ascription = {anno_expr: expression; type_annotation: type_expression}
and environment_element_definition =
| ED_binder
| ED_declaration of (expression * free_variables)

2
tools/webide/Dockerfile
View File

@ -17,7 +17,7 @@ FROM node:12-buster
WORKDIR /app
RUN apt-get update && apt-get -y install libev-dev perl pkg-config libgmp-dev libhidapi-dev m4 libcap-dev bubblewrap rsync
RUN apt-get update && apt-get -y install python3 libev-dev perl pkg-config libgmp-dev libhidapi-dev m4 libcap-dev bubblewrap rsync
COPY ligo_deb10.deb /tmp/ligo_deb10.deb
RUN dpkg -i /tmp/ligo_deb10.deb && rm /tmp/ligo_deb10.deb

36
vendors/UnionFind/UnionFind.install vendored
View File

@ -1,36 +0,0 @@
lib: [
"_build/install/default/lib/UnionFind/META"
"_build/install/default/lib/UnionFind/Partition.cmi"
"_build/install/default/lib/UnionFind/Partition.cmti"
"_build/install/default/lib/UnionFind/Partition.mli"
"_build/install/default/lib/UnionFind/Partition0.cmi"
"_build/install/default/lib/UnionFind/Partition0.cmt"
"_build/install/default/lib/UnionFind/Partition0.cmx"
"_build/install/default/lib/UnionFind/Partition0.ml"
"_build/install/default/lib/UnionFind/Partition1.cmi"
"_build/install/default/lib/UnionFind/Partition1.cmt"
"_build/install/default/lib/UnionFind/Partition1.cmx"
"_build/install/default/lib/UnionFind/Partition1.ml"
"_build/install/default/lib/UnionFind/Partition2.cmi"
"_build/install/default/lib/UnionFind/Partition2.cmt"
"_build/install/default/lib/UnionFind/Partition2.cmx"
"_build/install/default/lib/UnionFind/Partition2.ml"
"_build/install/default/lib/UnionFind/Partition3.cmi"
"_build/install/default/lib/UnionFind/Partition3.cmt"
"_build/install/default/lib/UnionFind/Partition3.cmx"
"_build/install/default/lib/UnionFind/Partition3.ml"
"_build/install/default/lib/UnionFind/UnionFind.a"
"_build/install/default/lib/UnionFind/UnionFind.cma"
"_build/install/default/lib/UnionFind/UnionFind.cmxa"
"_build/install/default/lib/UnionFind/UnionFind.cmxs"
"_build/install/default/lib/UnionFind/dune-package"
"_build/install/default/lib/UnionFind/opam"
"_build/install/default/lib/UnionFind/unionFind.cmi"
"_build/install/default/lib/UnionFind/unionFind.cmt"
"_build/install/default/lib/UnionFind/unionFind.cmx"
"_build/install/default/lib/UnionFind/unionFind.ml"
]
doc: [
"_build/install/default/doc/UnionFind/LICENSE"
"_build/install/default/doc/UnionFind/README.md"
]