├── src ├── Interpreter │ ├── HaskellSrc │ │ ├── .gitignore │ │ ├── exe │ │ │ ├── TreeMaker.hs │ │ │ ├── Interpreter.hs │ │ │ ├── subst_replacement │ │ │ └── Scheduler.hs │ │ ├── preprocess.sh │ │ ├── Interpreter.cabal │ │ └── extra_derivings │ ├── OCamlSrc │ │ ├── utils.ml │ │ ├── compile.sh │ │ ├── preprocessOCaml.sh │ │ └── interpreter.ml │ ├── ExampleASTs │ │ ├── README.md │ │ ├── preprocess_filenames.sh │ │ └── coqAST │ │ │ ├── fib.v │ │ │ ├── pmap.v │ │ │ ├── length_c.v │ │ │ ├── tak.v │ │ │ ├── length.v │ │ │ ├── length2.v │ │ │ ├── length3.v │ │ │ ├── nrev.v │ │ │ ├── mean_nnc.v │ │ │ ├── qsort.v │ │ │ └── length_u.v │ ├── ExampleProgExtraction.v │ ├── README.md │ ├── HaskellExtractionQuickCheck.v │ ├── OCamlExtraction.v │ └── HaskellExtraction.v ├── FrameStack │ ├── README.md │ └── Tests │ │ └── EvalExamples.v ├── Concurrent │ ├── Experimental │ │ ├── CoNodeSemantics.v │ │ └── Bisim.v │ ├── WeakBisim.v │ └── Ideas.md ├── BigStep │ ├── SideEffects.v │ ├── Environment.v │ ├── EraseNames.v │ └── MapEval.v ├── SideEffects.v ├── Assignments.v ├── Syntax.v └── Maps.v ├── Documentation ├── study.pdf └── bibliography.bib ├── LICENSE.txt ├── .gitignore ├── Erl_codes ├── equiv.erl ├── attempt.erl ├── weird.erl ├── a.erl ├── side_effect_tests.core ├── weird.S ├── weird2.S ├── attempt.core ├── side_effect_exception_tests.core ├── exception_tests.core ├── b.core ├── equiv.core ├── weird2.core └── tests.core ├── Makefile ├── .github └── workflows │ └── docker-action.yml ├── coq-core-erlang-formalization.opam ├── compilationorder.txt └── _CoqProject /src/Interpreter/HaskellSrc/.gitignore: -------------------------------------------------------------------------------- 1 | dist-newstyle -------------------------------------------------------------------------------- /Documentation/study.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/harp-project/Core-Erlang-Formalization/HEAD/Documentation/study.pdf -------------------------------------------------------------------------------- /src/Interpreter/OCamlSrc/utils.ml: -------------------------------------------------------------------------------- 1 | module PIDMap = Map.Make(Int) 2 | 3 | module PidPair = struct 4 | type t = int * int 5 | let compare = compare 6 | end 7 | 8 | module PIDPIDMap = Map.Make(PidPair) 9 | -------------------------------------------------------------------------------- /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Core Erlang Formalisation 2 | Copyright (c) 2020 Péter Bereczky, Eötvös Loránd University 3 | 4 | This program is licensed under LGPLv3 license. 5 | See the files COPYING and COPYING.LESSER for details. 6 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.log 2 | *.blg 3 | *.bbl 4 | *.aux 5 | *.gz 6 | *.out 7 | *.beam 8 | *.glob 9 | *.vo 10 | *.vos 11 | *.vok 12 | *.temp 13 | stack.yaml.lock 14 | .stack-work/ 15 | .vscode/ 16 | .history/ 17 | *.lia.cache 18 | *.nia.cache 19 | src/gen_test.v 20 | .Makefile.d 21 | *.crashcoqide 22 | *.cmi 23 | *.mli 24 | CoqMakefile 25 | CoqMakefile.conf 26 | .CoqMakefile.d 27 | 28 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/README.md: -------------------------------------------------------------------------------- 1 | # Example ASTs 2 | 3 | This directory contains example Core Erlang ASTs, in the syntax of the Coq formalization. 4 | All of the example programs were obtained from the [ErLLVM Benchmarking Suite](https://github.com/cstavr/erllvm-bench/tree/master) 5 | (from src/small in particular). The ASTs were obtained using the [pretty-printer](https://github.com/harp-project/erlang-semantics-testing/tree/frame-stack). 6 | -------------------------------------------------------------------------------- /src/Interpreter/OCamlSrc/compile.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | ocamlc -i utils.ml > utils.mli 4 | ocamlc -i CoqExtraction.ml > CoqExtraction.mli 5 | ocamlc -i interpreter.ml > interpreter.mli 6 | 7 | ocamlc -c utils.mli 8 | ocamlc -c utils.ml 9 | ocamlc -c CoqExtraction.mli 10 | ocamlc -c CoqExtraction.ml 11 | ocamlc -c interpreter.mli 12 | ocamlc -c interpreter.ml 13 | 14 | ocamlc utils.cmo CoqExtraction.cmo interpreter.cmo -o Interpreter 15 | -------------------------------------------------------------------------------- /Erl_codes/equiv.erl: -------------------------------------------------------------------------------- 1 | -module(equiv). 2 | -compile(export_all). 3 | 4 | exp1() -> 5 | E1 = 1+ 2, 6 | E2 = 1 + 2, 7 | E3 = 1 + 2, 8 | case 5 + 5 of 9 | true -> E2; 10 | _ -> E3 11 | end. 12 | 13 | exp2() -> 14 | E1 = 1+ 2, 15 | E2 = 1 + 2, 16 | E3 = 1 + 2, 17 | if 5 + 5 -> E2; 18 | true -> E3 19 | end. 20 | 21 | clause1(X, E1, E2) when length(X) == 0 -> E1; 22 | clause1(X, E1, E2) -> E2. 23 | 24 | clause2([], E1, E2) -> E1; 25 | clause2(X, E1, E2) -> E2. 26 | 27 | -------------------------------------------------------------------------------- /src/FrameStack/README.md: -------------------------------------------------------------------------------- 1 | # Core Erlang frame stack semantics 2 | 3 | This part of the repository contains the frame stack semantics of Core Erlang. It also includes different approaches to define the syntax, static semantics, and equivalence definitions. 4 | 5 | # Compilation 6 | 7 | To compile this part of the project, simply use `make`. 8 | 9 | If the above does not work, compile each of the files with `coqc` in the order they have been defined in `_CoqProject` with the `-R src Core_Erlang` parameters. 10 | 11 | -------------------------------------------------------------------------------- /src/Interpreter/HaskellSrc/exe/TreeMaker.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CoqExtraction 4 | import Prelude 5 | 6 | startNode :: Node 7 | startNode = makeInitialNode (RExp (EExp testqsort)) 8 | 9 | runKTauSteps :: Integer -> PID -> Node -> Node 10 | runKTauSteps n _ node | n <= 0 = node 11 | runKTauSteps n pid node = 12 | case interProcessTauStepFunc node pid of 13 | Just node' -> runKTauStep (n - 1) pid node' 14 | _ -> node 15 | 16 | advanceAllProcesses :: (Node, [Action]) -> (Node, [Action]) 17 | 18 | -- main :: IO Integer 19 | -- main = -------------------------------------------------------------------------------- /Erl_codes/attempt.erl: -------------------------------------------------------------------------------- 1 | -module(attempt). 2 | -compile(export_all). 3 | 4 | f1(X) -> X and 5. 5 | g1(X) -> X or 5. 6 | f2(X) -> X andalso 5. 7 | g2(X) -> X - 3. 8 | f3(X) -> not X. 9 | f4(X) -> X ++ [3, 4]. 10 | f5(X) -> X -- [1, 2]. 11 | f6(X) -> tuple_to_list(X). 12 | f7(X) -> list_to_tuple(X). 13 | f8(X) -> X == 5. 14 | f9(X) -> X /= 5. 15 | f10(X) -> X =/= 5. 16 | f11(X) -> X =:= 5. 17 | f12(Y) -> X = "cica" ++ Y, 18 | io:fwrite(X). 19 | f13(X) -> 20 | case X of 21 | #{1 := 2, 2 := 3} -> 1; 22 | Z -> 2 23 | end. 24 | 25 | f14(X, Y) -> X rem Y, X div Y. 26 | f15(X) -> tuple_size(X). 27 | f16(X) -> length(X). 28 | f17(X) -> hd(X). 29 | -------------------------------------------------------------------------------- /src/Interpreter/OCamlSrc/preprocessOCaml.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | file1="CoqExtraction.ml" 4 | file2="CoqExtraction.mli" 5 | import="open Utils" 6 | 7 | temp1=$(mktemp) 8 | temp2=$(mktemp) 9 | 10 | { 11 | echo "$import" 12 | tail -n +2 "$file1" 13 | } > "$temp1" 14 | 15 | mv "$temp1" "$file1" 16 | 17 | { 18 | echo "$import" 19 | tail -n +2 "$file2" 20 | } > "$temp2" 21 | 22 | mv "$temp2" "$file2" 23 | 24 | sed -i "s/^type processPool.*/type processPool = process PIDMap.t/" "$file1" 25 | sed -i "s/^type ether.*/type ether = (signal list) PIDPIDMap.t/" "$file1" 26 | 27 | sed -i "s/^type processPool.*/type processPool = process PIDMap.t/" "$file2" 28 | sed -i "s/^type ether.*/type ether = (signal list) PIDPIDMap.t/" "$file2" 29 | -------------------------------------------------------------------------------- /src/Concurrent/Experimental/CoNodeSemantics.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Export Concurrent.NodeSemantics. 2 | From CoreErlang Require Export CoList. 3 | 4 | (** Refexive, transitive closure, with action logs: *) 5 | Reserved Notation "n -[ l ]ₙ->* n'" (at level 50). 6 | CoInductive closureNodeSem : Node -> Trace (Action * PID) -> Node -> Prop := 7 | | n_refl n (* n' *): (* Permutation n n' -> *) n -[ []ₜ ]ₙ->* n (* ' *) 8 | | n_trans n n' n'' l a ι: 9 | n -[a|ι]ₙ-> n' -> n' -[l]ₙ->* n'' 10 | -> 11 | n -[(a,ι)::ₜ l]ₙ->* n'' 12 | where "n -[ l ]ₙ->* n'" := (closureNodeSem n l n'). 13 | 14 | Theorem closureNodeSem_trans : 15 | forall n n' l, n -[l]ₙ->* n' -> forall n'' l', n' -[l']ₙ->* n'' 16 | -> 17 | n -[l ++ₜ l']ₙ->* n''. 18 | Proof. 19 | cofix IHD1; intros n n' l D1; inv D1; intros; simpl. 20 | * rewrite trace_append_nil. exact H. 21 | * rewrite trace_append_cons. 22 | eapply n_trans. exact H. 23 | eapply (IHD1 _ _ _ H0) in H1. exact H1. 24 | Qed. 25 | -------------------------------------------------------------------------------- /Erl_codes/weird.erl: -------------------------------------------------------------------------------- 1 | -module(weird). 2 | -compile(export_all). 3 | 4 | f() -> 5 | self() ! 1, 6 | self() ! 2, 7 | self() ! 3, 8 | receive 9 | 2 when 1 / 0 -> "You got me" 10 | after 0 -> [receive X -> X after 0 -> "No more values" end, receive X -> X after 0 -> "No more values" end, receive X -> X after 0 -> "No more values" end] 11 | end. 12 | 13 | flush() -> 14 | receive 15 | X -> io:format("Process ~p got: ~p~n", [self(), X]), flush() 16 | after 17 | 0 -> ok 18 | end. 19 | 20 | g(X) -> 21 | case X of 22 | true -> spawn(weird, slave, [self()]); 23 | false -> ok 24 | end, 25 | receive 26 | 1 when false -> ok; 27 | 2 when false -> ok; 28 | 7 -> finished 29 | after 30 | 10 -> flush(), g(false) 31 | end. 32 | 33 | slave(Pid) -> 34 | Pid ! 1, 35 | Pid ! 2, 36 | timer:sleep(10), 37 | Pid ! 3, 38 | Pid ! 4, 39 | timer:sleep(10), 40 | Pid ! 5, 41 | Pid ! 6, 42 | timer:sleep(10), 43 | Pid ! 7. 44 | 45 | recurse() -> recurse(). 46 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | # KNOWNTARGETS will not be passed along to CoqMakefile 2 | KNOWNTARGETS := CoqMakefile extra-stuff extra-stuff2 3 | # KNOWNFILES will not get implicit targets from the final rule, and so 4 | # depending on them won't invoke the submake 5 | # Warning: These files get declared as PHONY, so any targets depending 6 | # on them always get rebuilt 7 | KNOWNFILES := Makefile _CoqProject 8 | 9 | .DEFAULT_GOAL := invoke-coqmakefile 10 | 11 | CoqMakefile: Makefile _CoqProject 12 | $(COQBIN)coq_makefile -f _CoqProject -o CoqMakefile 13 | 14 | invoke-coqmakefile: CoqMakefile 15 | $(MAKE) --no-print-directory -f CoqMakefile $(filter-out $(KNOWNTARGETS),$(MAKECMDGOALS)) 16 | 17 | .PHONY: invoke-coqmakefile $(KNOWNFILES) 18 | 19 | #################################################################### 20 | ## Your targets here ## 21 | #################################################################### 22 | 23 | # This should be the last rule, to handle any targets not declared above 24 | %: invoke-coqmakefile 25 | @true 26 | -------------------------------------------------------------------------------- /.github/workflows/docker-action.yml: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | name: Docker CI 4 | 5 | on: 6 | schedule: 7 | - cron: '10 1 * * 0' 8 | push: 9 | branches: 10 | - master 11 | pull_request: 12 | branches: 13 | - '**' 14 | 15 | jobs: 16 | build: 17 | # the OS must be GNU/Linux to be able to use the docker-coq-action 18 | runs-on: ubuntu-latest 19 | strategy: 20 | matrix: 21 | image: 22 | - 'coqorg/coq:8.20' 23 | fail-fast: false 24 | steps: 25 | - uses: actions/checkout@v4 26 | - uses: coq-community/docker-coq-action@v1 27 | with: 28 | opam_file: 'coq-core-erlang-formalization.opam' 29 | custom_image: ${{ matrix.image }} 30 | before_install: | 31 | startGroup "Setup and print opam config" 32 | opam repo -a --set-default add coq-extra-dev https://coq.inria.fr/opam/extra-dev 33 | opam config list; opam repo list; opam list 34 | endGroup 35 | 36 | 37 | # See also: 38 | # https://github.com/coq-community/docker-coq-action#readme 39 | # https://github.com/erikmd/docker-coq-github-action-demo 40 | -------------------------------------------------------------------------------- /Erl_codes/a.erl: -------------------------------------------------------------------------------- 1 | -module(a). 2 | -compile(export_all). 3 | 4 | fun1(X) -> 5 | if X == 4 -> 5; 6 | true -> io:fwrite("12") 7 | end. 8 | 9 | sword(1) -> throw(slice); 10 | sword(2) -> erlang:error(cut_arm); 11 | sword(3) -> exit(cut_leg); 12 | sword(4) -> throw(punch); 13 | sword(5) -> exit(cross_bridge). 14 | 15 | black_knight(Attack) when is_function(Attack, 0) -> 16 | try Attack() of 17 | _ -> "None shall pass." 18 | catch 19 | throw:slice -> "It is but a scratch."; 20 | error:cut_arm -> "I've had worse."; 21 | exit:cut_leg -> "Come on you pansy!"; 22 | _:_ -> "Just a flesh wound." 23 | end. 24 | 25 | length0(L) when length(L) == 0 -> 1; 26 | length0(_) -> 2. 27 | 28 | length02([]) -> 1; 29 | length02(_) -> 2. 30 | 31 | % From the "Erlang programming" book 32 | double([X|T], Buffer) -> 33 | double(T, Buffer ++ [X*2]); 34 | double([], Buffer) -> 35 | Buffer. 36 | 37 | double2([X|T], Buffer) -> 38 | double2(T, [X*2|Buffer]); 39 | double2([], Buffer) -> 40 | lists:reverse(Buffer). 41 | 42 | m1() -> 43 | try exit(alma) of 44 | _ -> ok 45 | catch _:_ -> nok 46 | end. 47 | 48 | m2() -> 49 | try exit(alma) of 50 | _ -> ok 51 | catch _ -> nok % exception is re-raised here in Core Erlang, because exit and error has to be matched with _:_ 52 | end. 53 | 54 | m3() -> 55 | try exit(self(),alma) of % This is an exit signal, it cannot be caught this way 56 | _ -> ok 57 | catch _:_ -> nok 58 | end. 59 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/preprocess_filenames.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # The pretty-printer gives back .v files in a uniform format. 4 | # In each file, the 5th line contains the start of the definition 5 | # of the Core Erlang AST. The name of the AST is always "test". 6 | # This script is just for convenience, it runs throught a directory 7 | # given as an argument, and in every file it renames "test" to 8 | # "test" + , where is the base name of 9 | # the file (without directories and .v). 10 | # 11 | # The script is here, because many of the .v files contain long 12 | # lines which can make CoqIDE crash, thus making these manual 13 | # renamings a bit cumbersome. 14 | # 15 | # Note that files containing other data would get replaced 16 | # as well, so it is recommended to only run this script on a 17 | # directory containing pretty-printed .v files, and to only run 18 | # it once. 19 | 20 | for file in "$@"; do 21 | if [ ! -f "$file" ]; then 22 | echo "Error: '$file' is not a file." 23 | continue 24 | fi 25 | 26 | name=$(basename "$file") 27 | name_no_ext="${name%.*}" 28 | 29 | tmpfile=$(mktemp) 30 | 31 | awk -v name="$name_no_ext" ' 32 | NR == 5 { 33 | pre = substr($0, 1, 15) 34 | post = substr($0, 16) 35 | print pre name post 36 | next 37 | } 38 | { print } 39 | ' "$file" > "$tmpfile" 40 | 41 | mv "$tmpfile" "$file" 42 | echo "Modified: $file" 43 | done 44 | -------------------------------------------------------------------------------- /coq-core-erlang-formalization.opam: -------------------------------------------------------------------------------- 1 | # This file was generated from `meta.yml`, please do not edit manually. 2 | # Follow the instructions on https://github.com/coq-community/templates to regenerate. 3 | 4 | opam-version: "2.0" 5 | maintainer: "berpeti@inf.elte.hu" 6 | version: "dev" 7 | 8 | homepage: "https://github.com/harp-project/core-erlang-formalization" 9 | dev-repo: "git+https://github.com/harp-project/core-erlang-formalization.git" 10 | bug-reports: "https://github.com/harp-project/core-erlang-formalization/issues" 11 | license: "LGPL-3.0-or-later" 12 | 13 | synopsis: "Core Erlang Formalisation in Coq" 14 | description: """ 15 | In this repository you can find the formalisation of a subset of Core Erlang in Coq Proof Assistant. The main features of the formalisation include: 16 | - The syntax of Core Erlang 17 | - A big-step, a functional big-step and a frame stack semantics of sequential Core Erlang 18 | - A frame stack semantics for a subset of concurrent Core Erlang 19 | - Proofs of semantic properties 20 | - Program correctness proofs 21 | - Program equivalence concepts, program equivalence proofs 22 | - An interpreter for Core Erlang based on the semantics 23 | """ 24 | 25 | build: [make "-j%{jobs}%"] 26 | install: [make "install"] 27 | depends: [ 28 | "coq" { >= "8.20" } 29 | "coq-stdpp" { = "1.11.0"} 30 | ] 31 | 32 | tags: [ 33 | "keyword:Core Erlang" 34 | "keyword:formal semantics" 35 | "keyword:program equivalence" 36 | "keyword:program correctness" 37 | "logpath:CoreErlang" 38 | ] 39 | authors: [ 40 | "Péter Bereczky" 41 | "Dániel Horpácsi" 42 | "Simon Thompson" 43 | "M.Sc. students from Eötvös Loránd University" 44 | ] 45 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleProgExtraction.v: -------------------------------------------------------------------------------- 1 | Require Coq.extraction.Extraction. 2 | Extraction Language Haskell. 3 | 4 | From CoreErlang.Interpreter Require Import StepFunctions. 5 | From CoreErlang.Interpreter Require Import Scheduler. 6 | From CoreErlang.Interpreter.ExampleASTs.coqAST Require Import decode fib huff length length2 length_c length_u life life2 life3 mean_nnc nrev qsort ring smith stable stable2 tak zip_nnc life4 pmap length3. 7 | 8 | Definition examplePrograms : list NonVal := 9 | [testdecode; testfib; testhuff; testlength; testlength2; 10 | testlength_c; testlength_u; testlife; testlife2; testlife3; 11 | testmean_nnc; testnrev; testqsort; testring; testsmith; 12 | teststable; teststable2; testtak; testzip_nnc; testlife4; testpmap; testlength3]. 13 | 14 | Require Import ExtrHaskellBasic. 15 | Require Import ExtrHaskellNatInteger. 16 | Require Import ExtrHaskellZInteger. 17 | Require Import ExtrHaskellString. 18 | 19 | (* Unfortunately the extraction does not allow ommitting definitions, 20 | so the type definitions are mapped to their counterparts in the 21 | imported file. Not that the import needs to be done by hand 22 | in the extracted file. 23 | *) 24 | Extract Inductive Lit => Lit [Atom Integer]. 25 | Extract Inductive Pat => Pat [PVar PLit PCons PTuple PMap PNil]. 26 | Extract Inductive Exp => Exp [VVal EExp]. 27 | Extract Inductive Val => Val [VNil VLit VPid VCons VTuple VMap VVar VFunId VClos]. 28 | Extract Inductive NonVal => NonVal 29 | [EFun EValues ECons ETuple EMap ECall EPrimOp EApp ECase ELet ESeq ELetRec ETry]. 30 | Extract Inlined Constant PID => PID. 31 | Extract Inlined Constant FunId => FunId. 32 | Extract Inlined Constant Var => Var. 33 | 34 | Extraction "HaskellSrc/exe/ExampleProgs.hs" examplePrograms. 35 | -------------------------------------------------------------------------------- /Erl_codes/side_effect_tests.core: -------------------------------------------------------------------------------- 1 | module 'side_effect_tests' ['module_info'/0, 2 | 'module_info'/1, 3 | 'tuple_eff'/0, 4 | 'list_eff'/0, 5 | 'case_eff'/0, 6 | 'call_eff'/0, 7 | 'apply_eff'/0, 8 | 'let_eff'/0, 9 | 'letrec_eff'/0, 10 | 'map_eff'/0, 11 | 'seq_eff'/0 12 | ] 13 | attributes [%% Line 1 14 | 'file' = 15 | %% Line 1 16 | [{[115|[105|[100|[101|[95|[101|[102|[102|[101|[99|[116|[95|[116|[101|[115|[116|[115|[46|[101|[114|[108]]]]]]]]]]]]]]]]]]]]],1}], 17 | %% Line 2 18 | 'compile' = 19 | %% Line 2 20 | ['export_all']] 21 | 'module_info'/0 = 22 | fun () -> 23 | call 'erlang':'get_module_info' 24 | ('side_effect_tests') 25 | 'module_info'/1 = 26 | fun (_0) -> 27 | call 'erlang':'get_module_info' 28 | ('side_effect_tests', _0) 29 | 30 | 'tuple_eff'/0 = fun() -> {call 'io':'fwrite'('a'), call 'io':'fwrite'('b'), call 'io':'fread'([], [126|[115]])} 31 | 32 | 'list_eff'/0 = fun() -> [call 'io':'fwrite'('a')|[call 'io':'fwrite'('b')|[]]] 33 | 34 | 'case_eff'/0 = fun() -> 35 | case call 'io':'fwrite'('a') of 36 | when 'false' -> call 'io':'fwrite'('b') 37 | <5> when 'true' -> 2 38 | when 'true' -> call 'io':'fwrite'('c') 39 | end 40 | 41 | 'call_eff'/0 = fun() -> 42 | call 'io':'fwrite'(call 'io':'fwrite'('a')) 43 | 44 | 'apply_eff'/0 = fun() -> 45 | let Y = fun(Z) -> call 'io':'fwrite'(call 'io':'fwrite'('c')) in 46 | apply let X = call 'io':'fwrite'(call 'io':'fwrite'('a')) in Y (call 'io':'fwrite'(call 'io':'fwrite'('b'))) 47 | 48 | 'let_eff'/0 = fun() -> 49 | let = call 'io':'fwrite'(call 'io':'fwrite'('b'))> in 50 | apply Y() 51 | 52 | 'letrec_eff'/0 = fun() -> 53 | letrec 'f1'/0 = fun() -> call 'io':'fwrite'('a') in 54 | apply 'f1'/0() 55 | 56 | 'map_eff'/0 = fun() -> 57 | ~{call 'io':'fwrite'('a') => call 'io':'fwrite'('b'), 58 | call 'io':'fwrite'('c') => 5}~ 59 | 60 | 'seq_eff'/0 = fun() -> 61 | do call 'io':'fwrite'('a') call 'io':'fwrite'('b') 62 | end -------------------------------------------------------------------------------- /compilationorder.txt: -------------------------------------------------------------------------------- 1 | coqc src/Basics.v -R src CoreErlang 2 | coqc src/Syntax.v -R src CoreErlang 3 | coqc src/Induction.v -R src CoreErlang 4 | coqc src/Equalities.v -R src CoreErlang 5 | coqc src/SideEffects.v -R src CoreErlang 6 | coqc src/Scoping.v -R src CoreErlang 7 | coqc src/Auxiliaries.v -R src CoreErlang 8 | coqc src/Maps.v -R src CoreErlang 9 | coqc src/Manipulation.v -R src CoreErlang 10 | coqc src/ScopingLemmas.v -R src CoreErlang 11 | coqc src/Matching.v -R src CoreErlang 12 | coqc src/FrameStack/Frames.v -R src CoreErlang 13 | coqc src/FrameStack/SubstSemantics.v -R src CoreErlang 14 | coqc src/FrameStack/Tests/Tests.v -R src CoreErlang 15 | coqc src/FrameStack/Tests/ExceptionTests.v -R src CoreErlang 16 | coqc src/FrameStack/Termination.v -R src CoreErlang 17 | coqc src/FrameStack/SubstSemanticsLemmas.v -R src CoreErlang 18 | coqc src/FrameStack/LogRel.v -R src CoreErlang 19 | coqc src/FrameStack/Compatibility.v -R src CoreErlang 20 | coqc src/FrameStack/CIU.v -R src CoreErlang 21 | coqc src/FrameStack/CTX.v -R src CoreErlang 22 | 23 | 24 | coqc src/BigStep/Syntax.v -R src CoreErlang 25 | coqc src/BigStep/Induction.v -R src CoreErlang 26 | coqc src/BigStep/Equalities.v -R src CoreErlang 27 | coqc src/BigStep/Helpers.v -R src CoreErlang 28 | coqc src/BigStep/Environment.v -R src CoreErlang 29 | coqc src/BigStep/SideEffects.v -R src CoreErlang 30 | coqc src/BigStep/Auxiliaries.v -R src CoreErlang 31 | coqc src/BigStep/ModuleAuxiliaries.v -R src CoreErlang 32 | coqc src/BigStep/FunctionalBigStep.v -R src CoreErlang 33 | coqc src/BigStep/BigStep.v -R src CoreErlang 34 | coqc src/BigStep/Coverage.v -R src CoreErlang 35 | coqc src/BigStep/Tactics.v -R src CoreErlang 36 | coqc src/BigStep/DeterminismHelpers.v -R src CoreErlang 37 | coqc src/BigStep/SemanticsProofs.v -R src CoreErlang 38 | coqc src/BigStep/SemanticsEquivalence.v -R src CoreErlang 39 | coqc src/BigStep/FullEquivalence.v -R src CoreErlang 40 | coqc src/BigStep/WeakEquivalence.v -R src CoreErlang 41 | coqc src/BigStep/WeakEquivalenceExamples.v -R src CoreErlang 42 | coqc src/BigStep/EquivalenceProofs.v -R src CoreErlang 43 | 44 | coqc src/BigStep/Tests/AutomatedTests.v -R src CoreErlang 45 | coqc src/BigStep/Tests/AutomatedSideEffectTests.v -R src CoreErlang 46 | coqc src/BigStep/Tests/AutomatedExceptionTests.v -R src CoreErlang 47 | coqc src/BigStep/Tests/AutomatedSideEffectExceptionTests.v -R src CoreErlang 48 | 49 | -------------------------------------------------------------------------------- /Documentation/bibliography.bib: -------------------------------------------------------------------------------- 1 | 2 | 3 | @phdthesis{fredlund2001framework, 4 | title={A framework for reasoning about {{E}}rlang code}, 5 | author={Fredlund, Lars-{\AA}ke}, 6 | year={2001}, 7 | school={Mikroelektronik och informationsteknik} 8 | } 9 | 10 | @inproceedings{nishida2016reversible, 11 | title={A reversible semantics for {{E}}rlang}, 12 | author={Nishida, Naoki and Palacios, Adri{\'a}n and Vidal, Germ{\'a}n}, 13 | booktitle={International Symposium on Logic-Based Program Synthesis and Transformation}, 14 | pages={259--274}, 15 | year={2016}, 16 | organization={Springer} 17 | } 18 | 19 | @article{fredlund2003verification, 20 | title={A verification tool for {{E}}rlang}, 21 | author={Fredlund, Lars--{\AA}ke and Gurov, Dilian and Noll, Thomas and Dam, Mads and Arts, Thomas and Chugunov, Gennady}, 22 | journal={International Journal on Software Tools for Technology Transfer}, 23 | volume={4}, 24 | number={4}, 25 | pages={405--420}, 26 | year={2003}, 27 | publisher={Springer} 28 | } 29 | 30 | @article{neuhausser2007abstraction, 31 | title={Abstraction and model checking of {{C}}ore {{E}}rlang programs in {{M}}aude}, 32 | author={Neuh{\"a}u{\ss}er, Martin and Noll, Thomas}, 33 | journal={Electronic Notes in Theoretical Computer Science}, 34 | volume={176}, 35 | number={4}, 36 | pages={147--163}, 37 | year={2007}, 38 | publisher={Elsevier} 39 | } 40 | 41 | @article{kHoszegikerl, 42 | title={{{KE}}rl: {{E}}xecutable semantics for {{E}}rlang}, 43 | author={K{\H{o}}szegi, Judit} 44 | } 45 | 46 | @inproceedings{vidal2014towards, 47 | title={Towards symbolic execution in {{E}}rlang}, 48 | author={Vidal, Germ{\'a}n}, 49 | booktitle={International Andrei Ershov Memorial Conference on Perspectives of System Informatics}, 50 | pages={351--360}, 51 | year={2014}, 52 | organization={Springer} 53 | } 54 | 55 | @book{huch1999verification, 56 | title={Verification of {{E}}rlang programs using abstract interpretation and model checking}, 57 | author={Huch, Frank}, 58 | volume={34}, 59 | number={9}, 60 | year={1999}, 61 | publisher={ACM} 62 | } 63 | 64 | @article{carlsson2000core, 65 | title={Core {{E}}rlang 1.0 language specification}, 66 | author={Carlsson, Richard and Gustavsson, Bj{\"o}rn and Johansson, Erik and Lindgren, Thomas and Nystr{\"o}m, Sven-Olof and Pettersson, Mikael and Virding, Robert}, 67 | journal={Information Technology Department, Uppsala University, Tech. Rep}, 68 | year={2000} 69 | } 70 | 71 | 72 | -------------------------------------------------------------------------------- /_CoqProject: -------------------------------------------------------------------------------- 1 | -R src CoreErlang 2 | 3 | src/Basics.v 4 | src/Syntax.v 5 | src/Induction.v 6 | src/Equalities.v 7 | src/SideEffects.v 8 | src/Scoping.v 9 | src/Auxiliaries.v 10 | src/Maps.v 11 | src/Manipulation.v 12 | src/ScopingLemmas.v 13 | src/Matching.v 14 | src/StrictEqualities.v 15 | 16 | src/FrameStack/Frames.v 17 | src/FrameStack/SubstSemanticsLabeled.v 18 | src/FrameStack/SubstSemantics.v 19 | src/FrameStack/Tests/Tests.v 20 | src/FrameStack/Tests/ExceptionTests.v 21 | src/FrameStack/Termination.v 22 | src/FrameStack/LabeledTermination.v 23 | src/FrameStack/SubstSemanticsLabeledLemmas.v 24 | src/FrameStack/SubstSemanticsLemmas.v 25 | src/FrameStack/LogRel.v 26 | src/FrameStack/Compatibility.v 27 | src/FrameStack/CIU.v 28 | src/FrameStack/Examples.v 29 | src/FrameStack/CTX.v 30 | src/FrameStack/Tests/EvalExamples.v 31 | 32 | src/FrameStack/Vulnerabilities/AtomExhaustion.v 33 | src/FrameStack/Vulnerabilities/AtomExhaustionExamples.v 34 | 35 | src/Concurrent/PIDRenaming.v 36 | src/Concurrent/ProcessSemantics.v 37 | src/Concurrent/NodeSemantics.v 38 | src/Concurrent/NodeSemanticsLemmas.v 39 | src/Concurrent/StrongBisim.v 40 | src/Concurrent/WeakBisim.v 41 | src/Concurrent/BarbedBisim.v 42 | src/Concurrent/BisimRenaming.v 43 | 44 | src/Concurrent/BisimReductions.v 45 | src/Concurrent/MapPmap.v 46 | 47 | src/Concurrent/ClosednessLemmas.v 48 | 49 | src/Interpreter/InterpreterAux.v 50 | src/Interpreter/InterpreterAuxLemmas.v 51 | src/Interpreter/StepFunctions.v 52 | src/Interpreter/Scheduler.v 53 | src/Interpreter/Equivalences.v 54 | src/Interpreter/ExampleASTs 55 | 56 | src/BigStep/Syntax.v 57 | src/BigStep/Induction.v 58 | src/BigStep/Equalities.v 59 | src/BigStep/Helpers.v 60 | src/BigStep/Environment.v 61 | src/BigStep/SideEffects.v 62 | src/BigStep/Auxiliaries.v 63 | src/BigStep/ModuleAuxiliaries.v 64 | src/BigStep/FunctionalBigStep.v 65 | src/BigStep/BigStep.v 66 | src/BigStep/Coverage.v 67 | src/BigStep/Tactics.v 68 | src/BigStep/EraseNames.v 69 | src/BigStep/DeterminismHelpers.v 70 | src/BigStep/SemanticsProofs.v 71 | src/BigStep/SemanticsEquivalence.v 72 | src/BigStep/FullEquivalence.v 73 | src/BigStep/WeakEquivalence.v 74 | src/BigStep/WeakEquivalenceExamples.v 75 | src/BigStep/EquivalenceProofs.v 76 | 77 | src/BigStep/MapEval.v 78 | src/BigStep/Tests/AutomatedTests.v 79 | src/BigStep/Tests/AutomatedSideEffectTests.v 80 | src/BigStep/Tests/AutomatedExceptionTests.v 81 | src/BigStep/Tests/AutomatedSideEffectExceptionTests.v 82 | src/BigStep/Tests/EvalExamples.v 83 | -------------------------------------------------------------------------------- /src/Interpreter/HaskellSrc/preprocess.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # This script is for processing the extracted Coq definitions 4 | # before they could be used by the Interpreter or TreeBuilder. 5 | # The script performs 3 operations: 6 | # 7 | # 1) It puts in the missing import at the top of the file 8 | # 2) It puts in Show and Eq derivings at the bottom of the file * 9 | # 3) It puts in NFData derivings at the bottom of the file ** 10 | # 11 | # * For Countable, Show and Eq instances cannot be derived, so 12 | # it is left out. Note that if gmaps and gsets get replaced, 13 | # Countable should not get extracted in the first place. 14 | # 15 | # ** NFData is needed for the deepseq library, which is in turn 16 | # needed for strict substitutions. These derivings were made 17 | # manually, and they were put in a file called "extra_derivings" 18 | 19 | file=$1 20 | 21 | temp=$(mktemp) 22 | 23 | import1="{-# LANGUAGE StrictData, StandaloneDeriving #-}" 24 | import2="import qualified Data.Bits" 25 | import3="import qualified Data.Char" 26 | import4="import qualified Data.HashMap.Strict" 27 | import5="import qualified Data.Hashable" 28 | import6="import qualified Data.HashSet" 29 | import7="import qualified Data.List" 30 | import8="import qualified GHC.Base" 31 | import9="import Control.DeepSeq" 32 | 33 | sed -e "1i\\ 34 | $import1"\ 35 | -e "3a\\ 36 | $import2\\ 37 | $import3\\ 38 | $import4\\ 39 | $import5\\ 40 | $import6\\ 41 | $import7\\ 42 | $import8\\ 43 | $import9" "$file" > "$temp" 44 | 45 | grep "^data" "$file" | \ 46 | awk '{for (i=2; i Prelude.Show (" $0 ")" 62 | 63 | printf "deriving instance (" 64 | for (i=2; i<=NF; i++) { 65 | printf "GHC.Base.Eq %s", $i 66 | if (i GHC.Base.Eq (" $0 ")" 71 | } 72 | } 73 | }' >> "$temp" 74 | 75 | sed -i -e 's/^type Gmap k a.*/type Gmap k a = Data.HashMap.Strict.HashMap k a/' \ 76 | -e 's/^type Gset k.*/type Gset k = Data.HashSet.HashSet k/' $temp 77 | 78 | cat extra_derivings >> "$temp" 79 | 80 | mv "$temp" "$file" 81 | -------------------------------------------------------------------------------- /Erl_codes/weird.S: -------------------------------------------------------------------------------- 1 | {module, weird}. %% version = 0 2 | 3 | {exports, [{f,0},{module_info,0},{module_info,1}]}. 4 | 5 | {attributes, []}. 6 | 7 | {labels, 19}. 8 | 9 | 10 | {function, f, 0, 2}. 11 | {label,1}. 12 | {line,[]}. 13 | {func_info,{atom,weird},{atom,f},0}. 14 | {label,2}. 15 | {allocate,6,0}. 16 | {init_yregs,{list,[{y,0},{y,1},{y,2},{y,3},{y,4},{y,5}]}}. 17 | {bif,self,{f,0},[],{x,0}}. 18 | {move,{integer,1},{x,1}}. 19 | send. 20 | {bif,self,{f,0},[],{x,0}}. 21 | {move,{integer,2},{x,1}}. 22 | send. 23 | {bif,self,{f,0},[],{x,0}}. 24 | {move,{integer,3},{x,1}}. 25 | send. 26 | {'try',{y,5},{f,6}}. 27 | {label,3}. 28 | {loop_rec,{f,5},{x,0}}. 29 | {test,is_eq_exact,{f,4},[{x,0},{integer,2}]}. 30 | {fmove,{float,1.0},{fr,0}}. 31 | {fmove,{float,0.0},{fr,1}}. 32 | {bif,fdiv,{f,0},[{fr,0},{fr,1}],{fr,0}}. 33 | {label,4}. 34 | {loop_rec_end,{f,3}}. 35 | {label,5}. 36 | {wait,{f,3}}. 37 | {label,6}. 38 | {try_case,{y,5}}. 39 | {move,{x,2},{y,2}}. 40 | {move,{x,1},{y,3}}. 41 | {move,{x,0},{y,4}}. 42 | {loop_rec,{f,7},{x,0}}. 43 | remove_message. 44 | {move,{x,0},{y,5}}. 45 | {jump,{f,8}}. 46 | {label,7}. 47 | timeout. 48 | {move,{atom,noval},{y,5}}. 49 | {label,8}. 50 | {loop_rec,{f,9},{x,0}}. 51 | remove_message. 52 | {move,{x,0},{y,1}}. 53 | {jump,{f,10}}. 54 | {label,9}. 55 | timeout. 56 | {move,{atom,noval},{y,1}}. 57 | {label,10}. 58 | {loop_rec,{f,11},{x,0}}. 59 | remove_message. 60 | {move,{x,0},{y,0}}. 61 | {jump,{f,12}}. 62 | {label,11}. 63 | timeout. 64 | {move,{atom,noval},{y,0}}. 65 | {label,12}. 66 | {loop_rec,{f,13},{x,0}}. 67 | remove_message. 68 | {jump,{f,14}}. 69 | {label,13}. 70 | timeout. 71 | {move,{atom,noval},{x,0}}. 72 | {label,14}. 73 | {test_heap,10,1}. 74 | {put_tuple2,{x,0},{list,[{y,5},{y,1},{y,0},{x,0}]}}. 75 | {put_tuple2,{x,0},{list,[{y,4},{y,3},{y,2},{x,0}]}}. 76 | {deallocate,6}. 77 | return. 78 | 79 | 80 | {function, module_info, 0, 16}. 81 | {label,15}. 82 | {line,[]}. 83 | {func_info,{atom,weird},{atom,module_info},0}. 84 | {label,16}. 85 | {move,{atom,weird},{x,0}}. 86 | {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. 87 | 88 | 89 | {function, module_info, 1, 18}. 90 | {label,17}. 91 | {line,[]}. 92 | {func_info,{atom,weird},{atom,module_info},1}. 93 | {label,18}. 94 | {move,{x,0},{x,1}}. 95 | {move,{atom,weird},{x,0}}. 96 | {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. 97 | -------------------------------------------------------------------------------- /src/Concurrent/Experimental/Bisim.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Concurrent.InductiveNodeSemantics. 2 | 3 | Import ListNotations. 4 | 5 | (* Definition dom (Π : ProcessPool) (l : list PID) : Prop := 6 | forall ι, ((Π ι <> None)%type -> In ι l) /\ 7 | (Π ι = None -> ~In ι l). *) 8 | 9 | (* This is wrong: it should also contain that ι is used in Π, but it is 10 | not associated with a process *) 11 | Definition isUnTaken (ι : PID) (Π : ProcessPool) : Prop := 12 | Π ι = None. 13 | 14 | Definition isPreCompatible (Π₁ Π₂ : ProcessPool) : Prop := 15 | forall ι, isUnTaken ι Π₁ -> isUnTaken ι Π₂. 16 | 17 | (* Definition isCompatible (Π₁ Π₂ : ProcessPool) : Prop := 18 | isPreCompatible Π₁ Π₂ /\ isPreCompatible Π₂ Π₁. *) 19 | Goal 20 | isPreCompatible 21 | (0 ↦ inl ([], RExp (`VNil), ([], []), [], false) ∥ 1 ↦ inl ([], RExp (`VNil), ([], []), [], false) ∥ nullpool) 22 | (0 ↦ inl ([], RExp (`VNil), ([], []), [], false) ∥ 1 ↦ inr [] ∥ nullpool). 23 | Proof. 24 | unfold isPreCompatible, isUnTaken in *. 25 | intros. 26 | destruct ι; cbn in *. 27 | congruence. 28 | destruct ι; cbn in *. 29 | congruence. 30 | assumption. 31 | Qed. 32 | 33 | Goal 34 | isPreCompatible 35 | (10 ↦ inl ([], RExp (`VNil), ([], []), [], false) ∥ 13 ↦ inl ([], RExp (`VNil), ([], []), [], false) ∥ nullpool) 36 | (13 ↦ inl ([], RExp (`VNil), ([], []), [], false) ∥ 10 ↦ inr [] ∥ nullpool). 37 | Proof. 38 | unfold isPreCompatible, isUnTaken in *. 39 | intros. 40 | destruct (Nat.eq_dec ι 13). 41 | * subst. cbn in *. congruence. 42 | * destruct (Nat.eq_dec ι 10). 43 | - subst. cbn in *. congruence. 44 | - rewrite update_next. rewrite update_next. all: auto. 45 | Qed. 46 | 47 | (* Definition isPreCompatibleReductions 48 | (n1 n2 : Node) l 49 | : Prop := 50 | isPreCompatible (snd n1) (snd n2) /\ 51 | Forall (fun ι' => isUnTaken ι' (snd n2)) (PIDsOf l). *) 52 | 53 | (* Definition isCompatibleReduction 54 | {Π₁ Π₂ Π₁' Π₂' : ProcessPool} {e1 e2 e1' e2' : Ether} {l l'} 55 | (red1 : (e1, Π₁) -[l]ₙ->* (e1', Π₁')) 56 | (red2 : (e2, Π₂) -[l']ₙ->* (e2', Π₂')) 57 | : Prop := 58 | isPreCompatibleReductions red1 red2 /\ 59 | isPreCompatibleReductions red2 red1. *) 60 | 61 | (* This does not say anything about the equivalence of actions 62 | TODO: this definition does not include the equivalence of ethers, which 63 | is included in Lanese et al. Playing with bisimulation in Erlang 64 | *) 65 | (* Definition simulates (S : Node -> Node -> Prop) := 66 | forall n₁ n₁' n₂ a ι (pf : S n₁ n₂) (red : n₁ -[a | ι]ₙ-> n₁'), 67 | exists n₂' l, n₂ -[l]ₙ->* n₂' /\ isPreCompatibleReductions n₁ n₂ l /\ S n₁' n₂'. *) 68 | -------------------------------------------------------------------------------- /src/Concurrent/WeakBisim.v: -------------------------------------------------------------------------------- 1 | (** 2 | This file defines weak barbed bisimulation, and shows that strong barbed 3 | bisimulations are weak too. 4 | *) 5 | 6 | From CoreErlang Require Export Concurrent.StrongBisim. 7 | 8 | Import ListNotations. 9 | 10 | Definition isSilent (a : Action) : Prop := 11 | match a with 12 | | τ => True 13 | | _ => False 14 | end. 15 | 16 | 17 | CoInductive weakBisim (O : gset PID) : (* nat -> *) Node -> Node -> Prop := 18 | (* | is_bisim_0 (A B : Node) : barbedBisim O 0 A B *) 19 | | is_strong_bisim (A B : Node) : 20 | (* symClos (preCompatibleNodes O) A B -> 21 | ether_wf A.1 -> 22 | ether_wf B.1 -> *) 23 | (forall A' a ι, 24 | A -[a | ι]ₙ-> A' with O -> 25 | exists B' B'' B''' l₁ l₂, 26 | Forall (isSilent ∘ fst) l₁ 27 | /\ Forall (isSilent ∘ fst) l₂ 28 | /\ B -[l₁]ₙ->* B' with O 29 | /\ B' -[a | ι]ₙ-> B'' with O 30 | /\ B'' -[l₂]ₙ->* B''' with O 31 | /\ weakBisim O (* n *) A' B''') -> 32 | (* NOTE: isSilent actions do not modify the ether *) 33 | (* (forall source dest, 34 | dest ∈ O -> 35 | exists B' l, 36 | Forall (isSilent ∘ fst) l 37 | /\ B -[l]ₙ->* B' with O 38 | /\ option_list_biforall Signal_eq (A.1 !! (source, dest)) (B'.1 !! (source, dest)) *) 39 | (forall source dest, 40 | dest ∈ O -> 41 | option_list_biforall Signal_eq (A.1 !! (source, dest)) (B.1 !! (source, dest)) 42 | (* NOTE: this part could be adjusted based on the equivalence we are 43 | interested in *)) -> 44 | (forall B' a ι, 45 | B -[a | ι]ₙ-> B' with O -> 46 | exists A' A'' A''' l₁ l₂, 47 | Forall (isSilent ∘ fst) l₁ 48 | /\ Forall (isSilent ∘ fst) l₂ 49 | /\ A -[l₁]ₙ->* A' with O 50 | /\ A' -[a | ι]ₙ-> A'' with O 51 | /\ A'' -[l₂]ₙ->* A''' with O 52 | /\ weakBisim O (* n *) A''' B') -> 53 | (* (forall source dest, 54 | dest ∈ O -> 55 | option_list_biforall Signal_eq (A.1 !! (source, dest)) (B.1 !! (source, dest)) 56 | (* NOTE: this part could be adjusted based on the equivalence we are 57 | interested in *)) -> *) 58 | weakBisim O (* (S n) *) A B 59 | . 60 | 61 | Notation "A ~ʷ B 'observing' O" := (weakBisim O A B) (at level 70). 62 | 63 | Theorem strong_is_weak : 64 | forall O A B, A ~ˢ B observing O -> A ~ʷ B observing O. 65 | Proof. 66 | cofix IH. intros. 67 | inv H; constructor; auto. 68 | * intros. apply H0 in H. destruct H as [B' H]. destruct_hyps. 69 | exists B, B', B', [], []. split_and!; try by constructor. 70 | exact H. by apply IH. 71 | * intros. apply H2 in H. destruct H as [A' H]. destruct_hyps. 72 | exists A, A', A', [], []. split_and!; try by constructor. 73 | exact H. by apply IH. 74 | Qed. 75 | -------------------------------------------------------------------------------- /src/Interpreter/README.md: -------------------------------------------------------------------------------- 1 | # Interpreter 2 | 3 | Using the interpreter in it's current state is not the most straightforward. 4 | A number of things are hard-coded in, and they need to be replaced by hand. 5 | The Pretty-printer currently cannot translate into Haskell code directly, 6 | which is why a fresh extraction needs to be performed. In the future we 7 | want to convert into Haskell directly, which would eliminate performing 8 | steps 5-12 altogether. The current process is as follows: 9 | 10 | 1. Build the whole project using `make`. Note that installing **std++** is required. This only needs to be done once. 11 | 2. Since the module system is not formalized yet, every instance of `spawn/3` needs to be replaced with a 2 parameter spawn (that does not actually exist in the Erlang system). In Erlang source files, replace every instance of `spawn(?MODULE, function, args)` with `spawn(fun (...) -> function (...) end, args)`, passing parameters to the function if needed. 12 | 3. Convert the Erlang source file to the Coq representation using the Pretty-printer. The Pretty-printer can be found in this repository: [erlang-semantics-testing](https://github.com/harp-project/erlang-semantics-testing/tree/frame-stack) 13 | 1. Navigate to the converter folder 14 | 2. Start the Erlang shell with `erl` 15 | 3. Compile cst\_to\_ast with `c(cst_to_ast).` 16 | 4. Compile pretty\_printer\_fs with `c(pretty_printer_fs).` 17 | 5. Convert the source to the Coq representation. The input and output files need to be given. 18 | - From an Erlang source file: `cst_to_ast:from_erl("example.erl", frameStack, "example.v").` 19 | - From a Core Erlang source file: `cst_to_ast:from_core("example.core", frameStack, "example.v").` 20 | 6. If the Pretty-printer gives warnings, the source code contains currently unsupported language features 21 | 4. Move the converted Erlang source file into src/Interpreter/ExampleASTs/coqAST 22 | 5. Open the file in Coqide and rename the definition, e.g. to `testexample` 23 | 6. Compile the file in Coqide 24 | 7. In src/Interpreter (this folder), open HaskellExtraction with Coqide 25 | 8. Put the file name in line 6 next to the other import files, without the **.v** extension 26 | 9. Put `;RExp testexample` (replaced with the real program name given in point 4) in the list of redexes in line 9 27 | 10. Compile HaskellExtraction.v in Coqide 28 | 11. Navigate to src/Interpreter/HaskellSrc inside a terminal window 29 | 12. Run `./preprocess.sh exe/CoqExtraction.hs` 30 | 13. Inside exe/Interpreter.hs, the end of line 14 can be changed to the program we want to run (e.g. `testexample`) 31 | 14. Build the Interpreter by running `cabal build Interpreter` 32 | 15. The interpreter can now be ran using `cabal run Interpreter` 33 | 34 | The interpreter will run the `main` function defined in the original Erlang source file, with an empty list of arguments. 35 | -------------------------------------------------------------------------------- /Erl_codes/weird2.S: -------------------------------------------------------------------------------- 1 | {module, weird2}. %% version = 0 2 | 3 | {exports, [{f,0},{module_info,0},{module_info,1}]}. 4 | 5 | {attributes, []}. 6 | 7 | {labels, 22}. 8 | 9 | 10 | {function, f, 0, 2}. 11 | {label,1}. 12 | {line,[]}. 13 | {func_info,{atom,weird2},{atom,f},0}. 14 | {label,2}. 15 | {allocate_heap,6,{alloc,[{words,0},{floats,0},{funs,1}]},0}. 16 | {init_yregs,{list,[{y,0},{y,1},{y,2},{y,3},{y,4},{y,5}]}}. 17 | {make_fun3,{f,21},0,0,{x,0},{list,[]}}. 18 | {call_ext,1,{extfunc,erlang,spawn,1}}. 19 | {bif,self,{f,0},[],{x,0}}. 20 | {move,{integer,1},{x,1}}. 21 | send. 22 | {bif,self,{f,0},[],{x,0}}. 23 | {move,{integer,2},{x,1}}. 24 | send. 25 | {bif,self,{f,0},[],{x,0}}. 26 | {move,{integer,3},{x,1}}. 27 | send. 28 | {'try',{y,5},{f,6}}. 29 | {label,3}. 30 | {loop_rec,{f,5},{x,0}}. 31 | {test,is_eq_exact,{f,4},[{x,0},{integer,3}]}. 32 | {fmove,{float,1.0},{fr,0}}. 33 | {fmove,{float,0.0},{fr,1}}. 34 | {bif,fdiv,{f,0},[{fr,0},{fr,1}],{fr,0}}. 35 | {label,4}. 36 | {loop_rec_end,{f,3}}. 37 | {label,5}. 38 | {wait,{f,3}}. 39 | {label,6}. 40 | {try_case,{y,5}}. 41 | {move,{x,2},{y,2}}. 42 | {move,{x,1},{y,3}}. 43 | {move,{x,0},{y,4}}. 44 | {label,7}. 45 | {wait_timeout,{f,7},{integer,10}}. 46 | timeout. 47 | {loop_rec,{f,8},{x,0}}. 48 | remove_message. 49 | {move,{x,0},{y,5}}. 50 | {jump,{f,9}}. 51 | {label,8}. 52 | timeout. 53 | {move,{atom,noval},{y,5}}. 54 | {label,9}. 55 | {loop_rec,{f,10},{x,0}}. 56 | remove_message. 57 | {move,{x,0},{y,1}}. 58 | {jump,{f,11}}. 59 | {label,10}. 60 | timeout. 61 | {move,{atom,noval},{y,1}}. 62 | {label,11}. 63 | {loop_rec,{f,12},{x,0}}. 64 | remove_message. 65 | {move,{x,0},{y,0}}. 66 | {jump,{f,13}}. 67 | {label,12}. 68 | timeout. 69 | {move,{atom,noval},{y,0}}. 70 | {label,13}. 71 | {loop_rec,{f,14},{x,0}}. 72 | remove_message. 73 | {jump,{f,15}}. 74 | {label,14}. 75 | timeout. 76 | {move,{atom,noval},{x,0}}. 77 | {label,15}. 78 | {test_heap,10,1}. 79 | {put_tuple2,{x,0},{list,[{y,5},{y,1},{y,0},{x,0}]}}. 80 | {put_tuple2,{x,0},{list,[{y,4},{y,3},{y,2},{x,0}]}}. 81 | {deallocate,6}. 82 | return. 83 | 84 | 85 | {function, module_info, 0, 17}. 86 | {label,16}. 87 | {line,[]}. 88 | {func_info,{atom,weird2},{atom,module_info},0}. 89 | {label,17}. 90 | {move,{atom,weird},{x,0}}. 91 | {call_ext_only,1,{extfunc,erlang,get_module_info,1}}. 92 | 93 | 94 | {function, module_info, 1, 19}. 95 | {label,18}. 96 | {line,[]}. 97 | {func_info,{atom,weird2},{atom,module_info},1}. 98 | {label,19}. 99 | {move,{x,0},{x,1}}. 100 | {move,{atom,weird},{x,0}}. 101 | {call_ext_only,2,{extfunc,erlang,get_module_info,2}}. 102 | 103 | 104 | {function, '-f/0-anonymous-0-', 0, 21}. 105 | {label,20}. 106 | {line,[]}. 107 | {func_info,{atom,weird2},{atom,'-f/0-anonymous-0-'},0}. 108 | {label,21}. 109 | {move,{literal,"o"},{x,0}}. 110 | {call_ext_only,1,{extfunc,io,fwrite,1}}. 111 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/fib.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testfib := ELetRec [(1, (EExp (ECase (VVal (VVar 6)) [([(PLit (Integer (0)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (0)))));([(PLit (Integer (1)))], (VVal (VLit (Atom "true"%string))), (VVal (VLit (Integer (1)))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VVar 0))])) (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 2));(VVal (VLit (Integer (2))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 1))) [(VVal (VVar 0))])) (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 2));(VVal (VVar 0))])))))))))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 6 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 6));(VVal (VVar 7))])) [([(PLit (Integer (0)));PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (3, 1))) [(VVal (VLit (Integer (34))))])) (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VVar 1));(VVal (VVar 0))])))))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 7 | (1, (EExp (ECase (VVal (VVar 6)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (1, 2))) [(VVal (VLit (Integer (30))));(VVal (VLit (Integer (0))))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 8 | (1, (EExp (ECase (VVal (VVar 6)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "fib"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 9 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "fib"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 10 | (1, (EExp (ECase (VVal (VVar 6)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "fib"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (2, 1))) [VVal VNil]). 11 | 12 | 13 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/pmap.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testpmap := ELetRec [(2, (EExp (ECase (VVal (VVar 5)) [([PNil], (VVal (VLit (Atom "true"%string))), (VVal VNil));([(PCons PVar PVar)], (VVal (VLit (Atom "true"%string))), (EExp (ECons (EExp (EApp (VVal (VVar 6)) [(VVal (VVar 0))])) (EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VVar 6));(VVal (VVar 1))])))))]))); 6 | (3, (EExp (ELetRec [(2, (EExp (ECase (VVal (VVar 2)) [([PNil], (VVal (VLit (Atom "true"%string))), (VVal VNil));([(PCons PVar PVar)], (VVal (VLit (Atom "true"%string))), (EExp (ECons (EExp (EApp (VVal (VVar 3)) [(VVal (VVar 0))])) (EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VVar 3));(VVal (VVar 1))])))))])))] (EExp (ECase (EExp (ECall (VVal (VLit (Atom "lists"%string))) (VVal (VLit (Atom "split"%string))) [(VVal (VVar 6));(VVal (VVar 7))])) [([(PTuple [PVar;PVar])], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "self"%string))) [])) (EExp (ESeq (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "spawn"%string))) [(EExp (EFun 0 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "!"%string))) [(VVal (VVar 0));(EExp (EApp (VVal (VFunId (3, 2))) [(VVal (VVar 8));(VVal (VVar 1))]))]))));(VVal VNil)])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (3, 2))) [(VVal (VVar 8));(VVal (VVar 2))])) (EExp (ELet 1 (VVal (VLit (Atom "infinity"%string))) (EExp (ELetRec [(0, (EExp (ELet 2 (EExp (EPrimOp "recv_peek_message"%string [])) (EExp (ECase (VVal (VVar 0)) [([(PLit (Atom "true"%string))], (VVal (VLit (Atom "true"%string))), (EExp (ECase (VVal (VVar 1)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ESeq (EExp (EPrimOp "remove_message"%string [])) (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "++"%string))) [(VVal (VVar 0));(VVal (VVar 5))])))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ESeq (EExp (EPrimOp "recv_next"%string [])) (EExp (EApp (VVal (VFunId (3, 0))) [])))))])));([(PLit (Atom "false"%string))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EPrimOp "recv_wait_timeout"%string [(VVal (VVar 3))])) (EExp (ECase (VVal (VVar 0)) [([(PLit (Atom "true"%string))], (VVal (VLit (Atom "true"%string))), (VVal VNil));([(PLit (Atom "false"%string))], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (3, 0))) [])))])))))])))))] (EExp (EApp (VVal (VFunId (0, 0))) [])))))))))))))]))))); 7 | (2, (EExp (ECase (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "=="%string))) [(VVal (VVar 4));(VVal (VLit (Integer (0))))])) [([(PLit (Atom "true"%string))], (VVal (VLit (Atom "true"%string))), (VVal VNil));([(PLit (Atom "false"%string))], (VVal (VLit (Atom "true"%string))), (EExp (ECons (VVal (VVar 5)) (EExp (EApp (VVal (VFunId (2, 2))) [(EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 4));(VVal (VLit (Integer (1))))]));(VVal (VVar 5))])))))]))); 8 | (1, (EExp (ELet 1 (EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VLit (Integer (100000))));(VVal (VLit (Integer (0))))])) (EExp (ELet 1 (EExp (EFun 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])))) (EExp (EApp (VVal (VFunId (3, 3))) [(VVal (VVar 0));(VVal (VLit (Integer (50000))));(VVal (VVar 1))])))))))] (EApp (VVal (VFunId (3, 1))) [VVal VNil]). 9 | 10 | 11 | -------------------------------------------------------------------------------- /src/Interpreter/HaskellSrc/exe/Interpreter.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import CoqExtraction 4 | import ExampleProgs 5 | import Scheduler 6 | 7 | import Prelude 8 | import Control.Monad.IO.Class 9 | import Control.Monad.State.Strict 10 | 11 | exampleForExec :: (Node, PID) 12 | exampleForExec = makeInitialConfig (RExp (EExp testlife4)) 13 | 14 | type NodeState s = StateT (Node, s) IO 15 | 16 | -- Tau and self actions do not get displayed. Epsilon actions do, although maybe that should be turned off as well. 17 | displayAction :: Scheduler s => PID -> Action -> NodeState s () 18 | displayAction pid action = 19 | case action of 20 | Coq__UU03c4_ -> return () 21 | Coq__UU03b5_ -> liftIO $ putStr "(P" >> putStr (show pid) >> putStrLn ") eps" 22 | ASelf _ -> return () 23 | ASend ps pd sig -> do 24 | liftIO $ putStr "(P" >> putStr (show ps) >> putStr ") ==[ (P" >> putStr (show pd) >> putStr ") ]==>\n\t" 25 | liftIO $ print sig 26 | AArrive ps pd sig -> do 27 | liftIO $ putStr "(P" >> putStr (show pd) >> putStr ") <==[ (P" >> putStr (show ps) >> putStr ") ]==\n\t" 28 | liftIO $ print sig 29 | ASpawn p _ _ _ -> do 30 | liftIO $ putStr "(P" >> putStr (show pid) >> putStr ") --{spawned}--> (P" >> putStr (show p) >> putStrLn ")" 31 | 32 | -- When a process terminates, all its links will get informed, regardless of what the scheduler wants. 33 | finishOffIfDead :: Scheduler s => PID -> NodeState s () 34 | finishOffIfDead pid = do 35 | (node, sched) <- get 36 | when (isDead node pid) 37 | (if isTotallyDead node pid 38 | then void $ put (node, removePID sched pid) 39 | else case nodeSimpleStep node (Left pid) of 40 | Just (node', action) -> do 41 | displayAction pid action 42 | put (node', changeByAction sched pid True action) 43 | finishOffIfDead pid 44 | _ -> liftIO $ putStr "Error: could not kill process P" >> putStr (show pid) 45 | ) 46 | 47 | -- Ask the scheduler for an operation, execute it, inform the scheduler of the action that was taken. 48 | evalProgram :: Scheduler s => NodeState s () 49 | evalProgram = do 50 | (node, sched) <- get 51 | case isEmpty sched of 52 | True -> return () 53 | False -> 54 | case getOperation sched of 55 | (_, Nothing) -> liftIO $ putStr "Error: the scheduler does not produce a step\n" >> putStrLn (show sched) 56 | (sched', Just (Left pid)) -> 57 | case nodeSimpleStep node (Left pid) of 58 | Just (node', action) -> do 59 | displayAction pid action 60 | put (node', changeByAction sched' pid False action) 61 | finishOffIfDead pid 62 | evalProgram 63 | _ -> do 64 | put (node, sched') 65 | evalProgram 66 | (sched', Just (Right (src, dst))) -> 67 | case nodeSimpleStep node (Right (src, dst)) of 68 | Just (node', action) -> do 69 | displayAction dst action 70 | put (node', changeByAction sched' dst False action) 71 | evalProgram 72 | _ -> 73 | liftIO $ putStr "Error: could not deliver signal between P" 74 | >> putStr (show src) >> putStr " and P" >> putStr (show dst) >> putStr "\n" 75 | >> putStr "(a signal might not have been sent)" 76 | 77 | main :: IO () 78 | main = runStateT evalProgram (fst exampleForExec, RoundRobin 10000 10000 [snd exampleForExec] [] 0) >>= print 79 | 80 | -------------------------------------------------------------------------------- /src/BigStep/SideEffects.v: -------------------------------------------------------------------------------- 1 | (** 2 | This file defines side effect traces for the big-step semantics. 3 | *) 4 | 5 | From CoreErlang.BigStep Require Export Environment Helpers Syntax. 6 | 7 | (** The side-effects of Core Erlang *) 8 | Import ListNotations. 9 | 10 | Inductive SideEffectId : Set := 11 | | Input 12 | | Output 13 | . 14 | 15 | Definition SideEffectList : Type := list (SideEffectId * list Value). 16 | 17 | Definition nth_def {A : Type} (l : list A) (def err : A) (i : nat) := 18 | match i with 19 | | 0 => def 20 | | S i' => nth i' l err 21 | end. 22 | 23 | Goal nth_def [4; 7; 8] 3 0 2 = 7. Proof. reflexivity. Qed. 24 | Goal nth_def [ [(Input, [VLit (Atom "a"%string)] )]; 25 | [(Input, [VLit (Atom "a"%string)] ); (Input, [VLit (Atom "b"%string)] )]; 26 | [(Input, [VLit (Atom "a"%string)] ); (Input, [VLit (Atom "b"%string)] ); (Input, [VLit (Atom "c"%string)] )]] [] [] 2 = [(Input, [VLit (Atom "a"%string)] ); (Input, [VLit (Atom "b"%string)] )]. Proof. reflexivity. Qed. 27 | 28 | Lemma nth_def_eq {A : Type} (l : list A) (i : nat) (e1 def err : A): 29 | nth_def (e1::l) def err (S i) = nth_def l e1 err i. 30 | Proof. 31 | simpl. destruct i. 32 | * simpl. reflexivity. 33 | * simpl. reflexivity. 34 | Qed. 35 | 36 | Theorem last_nth_equal {A : Type} (l : list A) (def err : A) : 37 | last l def = nth_def l def err (length l). 38 | Proof. 39 | induction l. 40 | * auto. 41 | * simpl. rewrite IHl. destruct l. 42 | - auto. 43 | - simpl. auto. 44 | Qed. 45 | 46 | Definition effect_id_eqb (id1 id2 : SideEffectId) : bool := 47 | match id1, id2 with 48 | | Input, Input => true 49 | | Output, Output => true 50 | | _, _ => false 51 | end. 52 | 53 | 54 | Definition effect_eqb (e1 e2 : SideEffectId * list Value) : bool := 55 | match e1, e2 with 56 | | (id1, vals1), (id2, vals2) => effect_id_eqb id1 id2 && list_eqb Value_full_eqb vals1 vals2 57 | end. 58 | 59 | Theorem effect_eqb_refl : 60 | forall e, 61 | effect_eqb e e = true. 62 | Proof. 63 | intros. unfold effect_eqb. destruct e. 64 | assert (effect_id_eqb s s = true). { destruct s; auto. } 65 | rewrite H. simpl. 66 | apply list_eqb_refl. 67 | intros. apply Value_full_eqb_refl. 68 | Qed. 69 | 70 | Theorem effect_list_eqb_refl : 71 | forall l, 72 | list_eqb effect_eqb l l = true. 73 | Proof. 74 | induction l. 75 | * auto. 76 | * simpl. apply andb_true_intro. rewrite effect_eqb_refl. auto. 77 | Qed. 78 | 79 | Proposition effect_eqb_eq : 80 | forall e1 e2, 81 | e1 = e2 82 | <-> 83 | effect_eqb e1 e2 = true. 84 | Proof. 85 | intros. split; destruct e1, e2. 86 | * intros. inversion H. subst. apply effect_eqb_refl. 87 | * intros. simpl in H. apply eq_sym, Bool.andb_true_eq in H. destruct H. 88 | apply eq_sym, value_full_list_eqb_eq in H0. subst. 89 | destruct s, s0; auto. 90 | inversion H. 91 | inversion H. 92 | Qed. 93 | 94 | Proposition effect_list_eqb_eq (l1 l2 : SideEffectList) : 95 | l1 = l2 96 | <-> 97 | list_eqb effect_eqb l1 l2 = true. 98 | Proof. 99 | split. 100 | * intros. subst. apply effect_list_eqb_refl. 101 | * generalize dependent l2. induction l1; intros. 102 | - simpl in H. destruct l2; auto. congruence. 103 | - simpl in H. destruct l2. 104 | + congruence. 105 | + apply eq_sym, Bool.andb_true_eq in H. destruct H. 106 | pose (IHl1 l2 (eq_sym H0)). rewrite e. 107 | apply eq_sym, effect_eqb_eq in H. rewrite H. auto. 108 | Qed. 109 | -------------------------------------------------------------------------------- /src/Interpreter/HaskellSrc/exe/subst_replacement: -------------------------------------------------------------------------------- 1 | -- This substitution assumes, that always the outermost variables are substituted, without capture avoidance 2 | preSubst :: [Val] -> Prelude.Integer -> Exp -> Exp 3 | preSubst l shift (EExp n) = 4 | let n' = (preSubstNonVal l shift n) 5 | in n' `deepseq` EExp n' 6 | preSubst l shift (VVal v) = 7 | let v' = (preSubstVal l shift v) 8 | in v' `deepseq` VVal v' 9 | 10 | preSubstVal :: [Val] -> Prelude.Integer -> Val -> Val 11 | preSubstVal subl shift ex = 12 | case ex of { 13 | VCons hd tl -> VCons (preSubstVal subl shift hd) (preSubstVal subl shift tl); 14 | VTuple l -> VTuple (Prelude.map (\x -> preSubstVal subl shift x) l); 15 | VMap l -> VMap 16 | (Prelude.map (\pat -> 17 | case pat of { 18 | (,) x y -> (,) (preSubstVal subl shift x) (preSubstVal subl shift y)}) l); 19 | VVar n -> 20 | if Data.List.genericLength subl Prelude.<= n Prelude.- shift Prelude.|| n Prelude.- shift Prelude.< 0 21 | then ex 22 | else Data.List.genericIndex subl (n Prelude.- shift); 23 | VFunId (n, a) -> 24 | if Data.List.genericLength subl Prelude.<= n Prelude.- shift Prelude.|| n Prelude.- shift Prelude.< 0 25 | then ex 26 | else Data.List.genericIndex subl (n Prelude.- shift); 27 | VClos ext id0 vl e -> VClos 28 | (Prelude.map (\pat -> 29 | case pat of { 30 | (,) y x -> 31 | case y of { 32 | (,) i ls -> (,) ((,) i ls) 33 | (preSubst subl (shift Prelude.+ Data.List.genericLength ext Prelude.+ ls) x)}}) ext) 34 | id0 vl 35 | (preSubst subl (shift Prelude.+ Data.List.genericLength ext Prelude.+ vl) e); 36 | _ -> ex} 37 | 38 | preSubstNonVal :: [Val] -> Prelude.Integer -> NonVal -> NonVal 39 | preSubstNonVal subl shift ex = 40 | case ex of { 41 | EFun vl e -> EFun vl (preSubst subl (shift Prelude.+ vl) e); 42 | EValues el -> EValues (Prelude.map (\x -> preSubst subl shift x) el); 43 | ECons hd tl -> ECons (preSubst subl shift hd) (preSubst subl shift tl); 44 | ETuple l -> ETuple (Prelude.map (\x -> preSubst subl shift x) l); 45 | EMap l -> EMap 46 | (Prelude.map (\pat -> 47 | case pat of { 48 | (,) x y -> (,) (preSubst subl shift x) (preSubst subl shift y)}) l); 49 | ECall m f l -> ECall (preSubst subl shift m) (preSubst subl shift f) 50 | (Prelude.map (\x -> preSubst subl shift x) l); 51 | EPrimOp f l -> EPrimOp f (Prelude.map (\x -> preSubst subl shift x) l); 52 | EApp e l -> EApp (preSubst subl shift e) (Prelude.map (\x -> preSubst subl shift x) l); 53 | ECase e l -> ECase (preSubst subl shift e) 54 | (Prelude.map (\pat -> 55 | case pat of { 56 | (,) y0 y -> 57 | case y0 of { 58 | (,) p x -> (,) ((,) p 59 | (preSubst subl (shift Prelude.+ patListScope p) x)) 60 | (preSubst subl (shift Prelude.+ patListScope p) y)}}) l); 61 | ELet l e1 e2 -> ELet l (preSubst subl shift e1) 62 | (preSubst subl (shift Prelude.+ l) e2); 63 | ESeq e1 e2 -> ESeq (preSubst subl shift e1) (preSubst subl shift e2); 64 | ELetRec l e -> ELetRec 65 | (Prelude.map (\pat -> 66 | case pat of { 67 | (,) n x -> (,) n 68 | (preSubst subl (shift Prelude.+ Data.List.genericLength l Prelude.+ n) x)}) l) 69 | (preSubst subl (shift Prelude.+ Data.List.genericLength l) e); 70 | ETry e1 vl1 e2 vl2 e3 -> ETry (preSubst subl shift e1) vl1 71 | (preSubst subl (shift Prelude.+ vl1) e2) vl2 72 | (preSubst subl (shift Prelude.+ vl2) e3)} 73 | 74 | subst l = preSubst l 0 75 | 76 | -------------------------------------------------------------------------------- /src/FrameStack/Tests/EvalExamples.v: -------------------------------------------------------------------------------- 1 | From CoreErlang.FrameStack Require Import Examples. 2 | Import ListNotations. 3 | 4 | Open Scope string_scope. 5 | 6 | Section increment. 7 | Context (v : Val) 8 | (Hv : VALCLOSED v). 9 | Definition inc : Exp := 10 | EFun 1 (ECall (˝VLit "erlang") (˝VLit "+") [˝VVar 0;˝VLit 1%Z]). 11 | Definition inc_app : Exp := EApp inc [˝v]. 12 | 13 | Local Definition final (v : Val) : Redex := 14 | match v with 15 | | VLit (Integer x) => RValSeq [VLit (x + 1)%Z] 16 | | _ => badarith (VTuple [VLit "+"; v; VLit 1%Z]) 17 | end. 18 | Local Lemma inc_eval : forall K, exists k, 19 | ⟨K, inc_app⟩ -[k]-> ⟨K, final v⟩. 20 | Proof. 21 | intros. eexists. 22 | (* evaluation *) 23 | unfold inc. 24 | do 4 do_step. 25 | do_step. 26 | econstructor. econstructor. reflexivity. simpl. 27 | do 6 do_step. 28 | do 3 do_step. 29 | econstructor. econstructor. reflexivity. simpl. 30 | cbn. 31 | (* final result: *) 32 | destruct v. 2: destruct l. 33 | all: simpl; apply step_refl. 34 | Qed. 35 | 36 | End increment. 37 | 38 | Section map. 39 | 40 | Local Lemma map_eval n : 41 | ⟨[], EApp (˝@map_clos n) [inc; ˝VCons (VLit 1%Z) (VCons (VLit 2%Z) (VCons (VLit 3%Z) VNil))]⟩ -->* RValSeq [VCons (VLit 2%Z) (VCons (VLit 3%Z) (VCons (VLit 4%Z) VNil))]. 42 | Proof. 43 | eexists. split. 44 | { 45 | constructor. 46 | } 47 | do 2 do_step. 48 | do 2 do_step. 49 | do 3 do_step. 50 | econstructor. econstructor. reflexivity. simpl. 51 | (* 1st application of map *) 52 | do 2 do_step. 53 | econstructor. eapply eval_step_case_not_match. reflexivity. 54 | econstructor. eapply eval_step_case_match. reflexivity. 55 | do 5 do_step. 56 | do 2 do_step. 57 | do_step. 58 | do 2 do_step. 59 | econstructor. econstructor. reflexivity. simpl. 60 | (* 2nd application of map *) 61 | do 2 do_step. 62 | econstructor. eapply eval_step_case_not_match. reflexivity. 63 | econstructor. eapply eval_step_case_match. reflexivity. 64 | do 5 do_step. 65 | do 2 do_step. 66 | do_step. 67 | do 2 do_step. 68 | econstructor. econstructor. reflexivity. simpl. 69 | (* 3rd application of map *) 70 | do 2 do_step. 71 | econstructor. eapply eval_step_case_not_match. reflexivity. 72 | econstructor. eapply eval_step_case_match. reflexivity. 73 | do 5 do_step. 74 | do 2 do_step. 75 | do_step. 76 | do 2 do_step. 77 | econstructor. econstructor. reflexivity. simpl. 78 | (* final application of map *) 79 | do 2 do_step. 80 | econstructor. eapply eval_step_case_match. reflexivity. simpl. 81 | do 2 do_step. 82 | (* applying +1 to each element *) 83 | do 4 do_step. 84 | do 2 do_step. 85 | do_step. 86 | econstructor. econstructor. reflexivity. simpl. 87 | do 4 do_step. 88 | do 2 do_step. 89 | do 3 do_step. 90 | econstructor. econstructor. reflexivity. cbn. 91 | (**) 92 | do 4 do_step. 93 | do 2 do_step. 94 | do_step. 95 | econstructor. econstructor. reflexivity. simpl. 96 | do 4 do_step. 97 | do 2 do_step. 98 | do 3 do_step. 99 | econstructor. econstructor. reflexivity. cbn. 100 | (**) 101 | do 4 do_step. 102 | do 2 do_step. 103 | do_step. 104 | econstructor. econstructor. reflexivity. simpl. 105 | do 4 do_step. 106 | do 2 do_step. 107 | do 3 do_step. 108 | econstructor. econstructor. reflexivity. cbn. 109 | (**) 110 | do_step. 111 | apply step_refl. 112 | Qed. 113 | 114 | End map. -------------------------------------------------------------------------------- /Erl_codes/attempt.core: -------------------------------------------------------------------------------- 1 | module 'attempt' ['f1'/1, 2 | 'f10'/1, 3 | 'f11'/1, 4 | 'f12'/1, 5 | 'f13'/1, 6 | 'f14'/2, 7 | 'f15'/1, 8 | 'f16'/1, 9 | 'f17'/1, 10 | 'f2'/1, 11 | 'f3'/1, 12 | 'f4'/1, 13 | 'f5'/1, 14 | 'f6'/1, 15 | 'f7'/1, 16 | 'f8'/1, 17 | 'f9'/1, 18 | 'g1'/1, 19 | 'g2'/1, 20 | 'module_info'/0, 21 | 'module_info'/1] 22 | attributes [%% Line 1 23 | 'file' = 24 | %% Line 1 25 | [{[97|[116|[116|[101|[109|[112|[116|[46|[101|[114|[108]]]]]]]]]]],1}], 26 | %% Line 2 27 | 'compile' = 28 | %% Line 2 29 | ['export_all']] 30 | 'f1'/1 = 31 | %% Line 4 32 | fun (_0) -> 33 | call 'erlang':'and' 34 | (_0, 5) 35 | 'g1'/1 = 36 | %% Line 5 37 | fun (_0) -> 38 | call 'erlang':'or' 39 | (_0, 5) 40 | 'f2'/1 = 41 | %% Line 6 42 | fun (_0) -> 43 | ( case _0 of 44 | ( <( 'true' 45 | -| ['compiler_generated'] )> when 'true' -> 46 | 5 47 | -| ['compiler_generated'] ) 48 | ( <( 'false' 49 | -| ['compiler_generated'] )> when 'true' -> 50 | 'false' 51 | -| ['compiler_generated'] ) 52 | ( <_1> when 'true' -> 53 | ( call ( 'erlang' 54 | -| ['compiler_generated'] ):( 'error' 55 | -| ['compiler_generated'] ) 56 | (( {( 'badarg' 57 | -| ['compiler_generated'] ),_1} 58 | -| ['compiler_generated'] )) 59 | -| ['compiler_generated'] ) 60 | -| ['compiler_generated'] ) 61 | end 62 | -| ['compiler_generated'] ) 63 | 'g2'/1 = 64 | %% Line 7 65 | fun (_0) -> 66 | call 'erlang':'-' 67 | (_0, 3) 68 | 'f3'/1 = 69 | %% Line 8 70 | fun (_0) -> 71 | call 'erlang':'not' 72 | (_0) 73 | 'f4'/1 = 74 | %% Line 9 75 | fun (_0) -> 76 | call 'erlang':'++' 77 | (_0, [3|[4]]) 78 | 'f5'/1 = 79 | %% Line 10 80 | fun (_0) -> 81 | call 'erlang':'--' 82 | (_0, [1|[2]]) 83 | 'f6'/1 = 84 | %% Line 11 85 | fun (_0) -> 86 | call 'erlang':'tuple_to_list' 87 | (_0) 88 | 'f7'/1 = 89 | %% Line 12 90 | fun (_0) -> 91 | call 'erlang':'list_to_tuple' 92 | (_0) 93 | 'f8'/1 = 94 | %% Line 13 95 | fun (_0) -> 96 | call 'erlang':'==' 97 | (_0, 5) 98 | 'f9'/1 = 99 | %% Line 14 100 | fun (_0) -> 101 | call 'erlang':'/=' 102 | (_0, 5) 103 | 'f10'/1 = 104 | %% Line 15 105 | fun (_0) -> 106 | call 'erlang':'=/=' 107 | (_0, 5) 108 | 'f11'/1 = 109 | %% Line 16 110 | fun (_0) -> 111 | call 'erlang':'=:=' 112 | (_0, 5) 113 | 'f12'/1 = 114 | %% Line 17 115 | fun (_0) -> 116 | let = 117 | [99|[105|[99|[97|_0]]]] 118 | in %% Line 18 119 | call 'io':'fwrite' 120 | (X) 121 | 'f13'/1 = 122 | %% Line 19 123 | fun (_0) -> 124 | %% Line 20 125 | case _0 of 126 | %% Line 21 127 | <~{1:=2,2:=3}~> when 'true' -> 128 | 1 129 | %% Line 22 130 | when 'true' -> 131 | 2 132 | end 133 | 'f14'/2 = 134 | %% Line 25 135 | fun (_0,_1) -> 136 | do call 'erlang':'rem' 137 | (_0, _1) 138 | call 'erlang':'div' 139 | (_0, _1) 140 | 'f15'/1 = 141 | %% Line 26 142 | fun (_0) -> 143 | call 'erlang':'tuple_size' 144 | (_0) 145 | 'f16'/1 = 146 | %% Line 27 147 | fun (_0) -> 148 | call 'erlang':'length' 149 | (_0) 150 | 'f17'/1 = 151 | %% Line 28 152 | fun (_0) -> 153 | call 'erlang':'hd' 154 | (_0) 155 | 'module_info'/0 = 156 | fun () -> 157 | call 'erlang':'get_module_info' 158 | ('attempt') 159 | 'module_info'/1 = 160 | fun (_0) -> 161 | call 'erlang':'get_module_info' 162 | ('attempt', _0) 163 | end -------------------------------------------------------------------------------- /Erl_codes/side_effect_exception_tests.core: -------------------------------------------------------------------------------- 1 | module 'side_effect_exception_tests' ['module_info'/0, 2 | 'module_info'/1, 3 | 'eval_list_tail'/0, 4 | 'eval_list_head'/0, 5 | 'eval_tuple_s_e'/0, 6 | 'eval_try_s_e'/0, 7 | 'eval_catch'/0, 8 | 'eval_case_pat'/0, 9 | 'eval_case_clause'/1, 10 | %'eval_case_guard'/0, 11 | 'eval_call_s_e'/0, 12 | 'eval_apply_closure_ex'/0, 13 | 'eval_apply_param'/0, 14 | 'eval_apply_closure'/0, 15 | 'eval_apply_param_len'/0, 16 | 'eval_let'/0, 17 | 'eval_map_key'/0, 18 | 'eval_map_value'/0, 19 | 'eval_seq_1'/0, 20 | 'eval_seq_2'/0 21 | ] 22 | attributes [%% Line 1 23 | 'file' = 24 | %% Line 1 25 | [{[115|[105|[100|[101|[95|[101|[102|[102|[101|[99|[116|[95|[101|[120|[99|[101|[112|[116|[105|[111|[110|[95|[116|[101|[115|[116|[115|[46|[101|[114|[108]]]]]]]]]]]]]]]]]]]]]]]]]]]]]]],1}], 26 | %% Line 2 27 | 'compile' = 28 | %% Line 2 29 | ['export_all']] 30 | 'module_info'/0 = 31 | fun () -> 32 | call 'erlang':'get_module_info' 33 | ('side_effect_exception_tests') 34 | 'module_info'/1 = 35 | fun (_0) -> 36 | call 'erlang':'get_module_info' 37 | ('side_effect_exception_tests', _0) 38 | 39 | 'eval_list_tail'/0 = fun() -> 40 | [call 'io':'fwrite'('a')|[let X = call 'io':'fwrite'('b') in apply 0()|[]]] 41 | 42 | 'eval_list_head'/0 = fun() -> 43 | [apply 0()|[call 'io':'fwrite'('a')|[]]] 44 | 45 | 'eval_tuple_s_e'/0 = fun() -> 46 | {call 'io':'fwrite'('a'),let X = call 'io':'fwrite'('b') in apply 0()} 47 | 48 | 'eval_try_s_e'/0 = fun() -> 49 | try call 'io':'fwrite'('a') of 50 | -> let X = call 'io':'fwrite'('b') in apply 0() 51 | catch -> 'error' 52 | 53 | 'eval_catch'/0 = fun() -> 54 | try let X = call 'io':'fwrite'('a') in apply 0() of 55 | -> call 'io':'fwrite'('b') 56 | catch -> call 'io':'fwrite'('c') 57 | 58 | 'eval_case_pat'/0 = fun() -> 59 | case let X = call 'io':'fwrite'('a') in apply 0() of 60 | when 'true' -> call 'io':'fwrite'('b') 61 | end 62 | 63 | 'eval_case_clause'/1 = fun(Y) -> 64 | case let X = call 'io':'fwrite'('a') in Y of 65 | <1> when 'true' -> call 'io':'fwrite'('b') 66 | when 'false' -> call 'io':'fwrite'('c') 67 | end 68 | 69 | 'eval_call_s_e'/0 = fun() -> 70 | call 'io':'fwrite'(call 'io':'fwrite'('a'), apply 0()) 71 | 72 | 'eval_apply_closure_ex'/0 = fun() -> 73 | apply let X = call 'io':'fwrite'('a') in apply 0()() 74 | 75 | 'eval_apply_param'/0 = fun() -> 76 | apply call 'io':'fwrite'('a')(let X = call 'io':'fwrite'('b') in apply 0()) 77 | 78 | 'eval_apply_closure'/0 = fun() -> 79 | apply call 'io':'fwrite'('a')(call 'io':'fwrite'('b')) 80 | 81 | 'eval_apply_param_len'/0 = fun() -> 82 | let X = fun() -> 5 in 83 | apply X(call 'io':'fwrite'('a')) 84 | 85 | 'eval_let'/0 = fun() -> 86 | let X = let Y = call 'io':'fwrite'('a') in apply 2() in apply 0() 87 | 88 | 'eval_map_key'/0 = fun() -> 89 | ~{call 'io':'fwrite'('a') => call 'io':'fwrite'('b'), 90 | let X = call 'io':'fwrite'('c') in apply 0() => call 'io':'fwrite'('d')}~ 91 | 92 | 'eval_map_value'/0 = fun() -> 93 | ~{call 'io':'fwrite'('a') => call 'io':'fwrite'('b'), 94 | call 'io':'fwrite'('c') => let X = call 'io':'fwrite'('d') in apply 0()}~ 95 | 96 | 'eval_seq_1'/0 = fun() -> 97 | do let X = call 'io':'fwrite'('a') in apply 0() call 'io':'fwrite'('b') 98 | 99 | 'eval_seq_2'/0 = fun() -> 100 | do call 'io':'fwrite'('a') do let X = call 'io':'fwrite'('b') in apply 0() call 'io':'fwrite'('c') 101 | 102 | end -------------------------------------------------------------------------------- /src/SideEffects.v: -------------------------------------------------------------------------------- 1 | (** This file defines side-effect traces (which currently includes input and 2 | output logs). Currently, these side effects are only traced in the big-step 3 | semantics, but should be included for the frame stack semantics in the 4 | future. 5 | *) 6 | 7 | From CoreErlang Require Export Syntax. 8 | 9 | Import ListNotations. 10 | 11 | Inductive SideEffectId : Set := 12 | | Input 13 | | Output 14 | | AtomCreation 15 | . 16 | 17 | Definition SideEffect : Set := SideEffectId * list Val. 18 | 19 | Definition SideEffectList : Set := list SideEffect. 20 | 21 | (** A custom definition for indexing, starting from 1 rather than 0. *) 22 | Definition nth_def {A : Type} (l : list A) (def err : A) (i : nat) := 23 | match i with 24 | | 0 => def 25 | | S i' => nth i' l err 26 | end. 27 | 28 | Goal nth_def [4; 7; 8] 3 0 2 = 7. Proof. reflexivity. Qed. 29 | Goal nth_def [ [(Input, [VLit (Atom "a"%string)] )]; 30 | [(Input, [VLit (Atom "a"%string)] ); (Input, [VLit (Atom "b"%string)] )]; 31 | [(Input, [VLit (Atom "a"%string)] ); (Input, [VLit (Atom "b"%string)] ); 32 | (Input, [VLit (Atom "c"%string)] )]] [] [] 2 33 | = [(Input, [VLit (Atom "a"%string)] ); 34 | (Input, [VLit (Atom "b"%string)] )]. 35 | Proof. reflexivity. Qed. 36 | 37 | Lemma nth_def_eq {A : Type} (l : list A) (i : nat) (e1 def err : A): 38 | nth_def (e1::l) def err (S i) = nth_def l e1 err i. 39 | Proof. 40 | simpl. destruct i. 41 | * simpl. reflexivity. 42 | * simpl. reflexivity. 43 | Qed. 44 | 45 | Theorem last_nth_equal {A : Type} (l : list A) (def err : A) : 46 | last l def = nth_def l def err (length l). 47 | Proof. 48 | induction l. 49 | * auto. 50 | * simpl. rewrite IHl. destruct l. 51 | - auto. 52 | - simpl. auto. 53 | Qed. 54 | 55 | (* Definition effect_id_eqb (id1 id2 : SideEffectId) : bool := 56 | match id1, id2 with 57 | | Input, Input => true 58 | | Output, Output => true 59 | | _, _ => false 60 | end. 61 | 62 | 63 | Definition effect_eqb (e1 e2 : SideEffectId * list Val) : bool := 64 | match e1, e2 with 65 | | (id1, vals1), (id2, vals2) => effect_id_eqb id1 id2 && list_eqb Value_full_eqb vals1 vals2 66 | end. 67 | 68 | Theorem effect_eqb_refl : 69 | forall e, 70 | effect_eqb e e = true. 71 | Proof. 72 | intros. unfold effect_eqb. destruct e. 73 | assert (effect_id_eqb s s = true). { destruct s; auto. } 74 | rewrite H. simpl. 75 | apply list_eqb_refl. 76 | intros. apply Value_full_eqb_refl. 77 | Qed. 78 | 79 | Theorem effect_list_eqb_refl : 80 | forall l, 81 | list_eqb effect_eqb l l = true. 82 | Proof. 83 | induction l. 84 | * auto. 85 | * simpl. apply andb_true_intro. rewrite effect_eqb_refl. auto. 86 | Qed. 87 | 88 | Proposition effect_eqb_eq : 89 | forall e1 e2, 90 | e1 = e2 91 | <-> 92 | effect_eqb e1 e2 = true. 93 | Proof. 94 | intros. split; destruct e1, e2. 95 | * intros. inversion H. subst. apply effect_eqb_refl. 96 | * intros. simpl in H. apply eq_sym, Bool.andb_true_eq in H. destruct H. 97 | apply eq_sym, value_full_list_eqb_eq in H0. subst. 98 | destruct s, s0; auto. 99 | inversion H. 100 | inversion H. 101 | Qed. 102 | 103 | Proposition effect_list_eqb_eq (l1 l2 : SideEffectList) : 104 | l1 = l2 105 | <-> 106 | list_eqb effect_eqb l1 l2 = true. 107 | Proof. 108 | split. 109 | * intros. subst. apply effect_list_eqb_refl. 110 | * generalize dependent l2. induction l1; intros. 111 | - simpl in H. destruct l2; auto. congruence. 112 | - simpl in H. destruct l2. 113 | + congruence. 114 | + apply eq_sym, Bool.andb_true_eq in H. destruct H. 115 | pose (IHl1 l2 (eq_sym H0)). rewrite e. 116 | apply eq_sym, effect_eqb_eq in H. rewrite H. auto. 117 | Qed. *) 118 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/length_c.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testlength_c := ELetRec [(1, (EExp (ECase (VVal (VVar 8)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "length"%string))) [(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 6 | (1, (EExp (ECase (VVal (VVar 8)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (3, 2))) [(VVal (VVar 0));(VVal VNil)])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 7 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 8));(VVal (VVar 9))])) [([(PLit (Integer (0)));PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VVar 0));(EExp (ECons (VVal (VLit (Integer (0)))) (VVal (VVar 2))))])))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 8 | (3, (EExp (ECase (EExp (EValues [(VVal (VVar 8));(VVal (VVar 9));(VVal (VVar 10))])) [([(PLit (Integer (0)));PVar;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 1)));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 1))) [(VVal (VVar 2))])) (EExp (EApp (VVal (VFunId (8, 3))) [(VVal (VVar 1));(VVal (VVar 3));(VVal (VVar 0))])))))));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2))]))])))]))); 9 | (1, (EExp (ECase (VVal (VVar 8)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EApp (VVal (VFunId (1, 1))) [(VVal (VLit (Integer (20000))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 3))) [(VVal (VLit (Integer (50000))));(VVal (VVar 0));(VVal (VLit (Integer (0))))])) (VVal (VVar 0)))))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 10 | (1, (EExp (ECase (VVal (VVar 8)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "length_c"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 11 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length_c"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 12 | (1, (EExp (ECase (VVal (VVar 8)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length_c"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (4, 1))) [VVal VNil]). 13 | 14 | 15 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/tak.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testtak := ELetRec [(3, (EExp (ECase (EExp (EValues [(VVal (VVar 6));(VVal (VVar 7));(VVal (VVar 8))])) [([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECase (EExp (EValues [])) [([], (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "<"%string))) [(VVal (VVar 1));(VVal (VVar 0))])), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 3))) [(VVal (VVar 0));(VVal (VVar 2));(VVal (VVar 3))])) (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 3));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (6, 3))) [(VVal (VVar 0));(VVal (VVar 5));(VVal (VVar 3))])) (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 6));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (8, 3))) [(VVal (VVar 0));(VVal (VVar 5));(VVal (VVar 6))])) (EExp (EApp (VVal (VFunId (9, 3))) [(VVal (VVar 4));(VVal (VVar 2));(VVal (VVar 0))])))))))))))))));([], (VVal (VLit (Atom "true"%string))), (VVal (VVar 2)));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(VVal (VLit (Atom "if_clause"%string)))])))])));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2))]))])))]))); 6 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 6));(VVal (VVar 7))])) [([(PLit (Integer (0)));PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (3, 3))) [(VVal (VLit (Integer (32))));(VVal (VLit (Integer (22))));(VVal (VLit (Integer (16))))])) (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VVar 1));(VVal (VVar 0))])))))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 7 | (1, (EExp (ECase (VVal (VVar 6)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (1, 2))) [(VVal (VLit (Integer (1000))));(VVal (VLit (Integer (0))))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 8 | (1, (EExp (ECase (VVal (VVar 6)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "tak"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 9 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "tak"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 10 | (1, (EExp (ECase (VVal (VVar 6)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "tak"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (2, 1))) [VVal VNil]). 11 | 12 | 13 | -------------------------------------------------------------------------------- /src/Interpreter/HaskellSrc/Interpreter.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 3.0 2 | -- The cabal-version field refers to the version of the .cabal specification, 3 | -- and can be different from the cabal-install (the tool) version and the 4 | -- Cabal (the library) version you are using. As such, the Cabal (the library) 5 | -- version used must be equal or greater than the version stated in this field. 6 | -- Starting from the specification version 2.2, the cabal-version field must be 7 | -- the first thing in the cabal file. 8 | 9 | -- Initial package description 'Interpreter' generated by 10 | -- 'cabal init'. For further documentation, see: 11 | -- http://haskell.org/cabal/users-guide/ 12 | -- 13 | -- The name of the package. 14 | name: Interpreter 15 | 16 | -- The package version. 17 | -- See the Haskell package versioning policy (PVP) for standards 18 | -- guiding when and how versions should be incremented. 19 | -- https://pvp.haskell.org 20 | -- PVP summary: +-+------- breaking API changes 21 | -- | | +----- non-breaking API additions 22 | -- | | | +--- code changes with no API change 23 | version: 0.1.0.0 24 | 25 | -- A short (one-line) description of the package. 26 | -- synopsis: 27 | 28 | -- A longer description of the package. 29 | -- description: 30 | 31 | -- The license under which the package is released. 32 | license: LGPL-3.0-only 33 | 34 | -- The package author(s). 35 | author: No Name 36 | 37 | -- An email address to which users can send suggestions, bug reports, and patches. 38 | maintainer: n/a 39 | 40 | -- A copyright notice. 41 | -- copyright: 42 | build-type: Simple 43 | 44 | -- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. 45 | 46 | -- Extra source files to be distributed with the package, such as examples, or a tutorial module. 47 | -- extra-source-files: 48 | 49 | common warnings 50 | ghc-options: -Wall 51 | 52 | executable Interpreter 53 | -- Import common warning flags. 54 | import: warnings 55 | 56 | -- .hs or .lhs file containing the Main module. 57 | main-is: Interpreter.hs 58 | 59 | -- Modules included in this executable, other than Main. 60 | other-modules: CoqExtraction, 61 | ExampleProgs, 62 | Scheduler 63 | 64 | -- LANGUAGE extensions used by modules in this package. 65 | -- other-extensions: 66 | 67 | -- Other library packages from which modules are imported. 68 | build-depends: 69 | base >=4.18.0.0, 70 | hashable ^>=1.5.0.0, 71 | unordered-containers ^>= 0.2.20, 72 | transformers ^>=0.5.6.2, 73 | mtl ^>=2.2.2, 74 | deepseq ^>=1.4.8.1 75 | 76 | -- Directories containing source files. 77 | hs-source-dirs: exe 78 | 79 | -- Base language which the package is written in. 80 | default-language: Haskell2010 81 | 82 | executable TreeMaker 83 | -- Import common warning flags. 84 | import: warnings 85 | 86 | -- .hs or .lhs file containing the Main module. 87 | main-is: TreeMaker.hs 88 | 89 | -- Modules included in this executable, other than Main. 90 | other-modules: CoqExtraction 91 | 92 | -- LANGUAGE extensions used by modules in this package. 93 | -- other-extensions: 94 | 95 | -- Other library packages from which modules are imported. 96 | build-depends: 97 | base >=4.18.0.0, 98 | hashable ^>=1.5.0.0, 99 | unordered-containers ^>= 0.2.20, 100 | transformers ^>=0.5.6.2, 101 | mtl ^>=2.2.2 102 | 103 | -- Directories containing source files. 104 | hs-source-dirs: exe 105 | 106 | -- Base language which the package is written in. 107 | default-language: Haskell2010 108 | -------------------------------------------------------------------------------- /src/Interpreter/HaskellSrc/extra_derivings: -------------------------------------------------------------------------------- 1 | 2 | instance NFData Lit where 3 | rnf (Atom s) = rnf s 4 | rnf (Integer i) = rnf i 5 | 6 | instance NFData Exp where 7 | rnf (VVal v) = rnf v 8 | rnf (EExp e) = rnf e 9 | 10 | instance NFData Val where 11 | rnf VNil = () 12 | rnf (VLit l) = rnf l 13 | rnf (VPid pid) = rnf pid 14 | rnf (VCons v1 v2) = rnf v1 `Prelude.seq` rnf v2 15 | rnf (VTuple vs) = rnf vs 16 | rnf (VMap vps) = rnf vps 17 | rnf (VVar v) = rnf v 18 | rnf (VFunId f) = rnf f 19 | rnf (VClos env n1 n2 body) = rnf env `Prelude.seq` rnf n1 `Prelude.seq` rnf n2 `Prelude.seq` rnf body 20 | 21 | instance NFData NonVal where 22 | rnf (EFun n e) = rnf n `Prelude.seq` rnf e 23 | rnf (EValues es) = rnf es 24 | rnf (ECons e1 e2) = rnf e1 `Prelude.seq` rnf e2 25 | rnf (ETuple es) = rnf es 26 | rnf (EMap m) = rnf m 27 | rnf (ECall f arg args) = rnf f `Prelude.seq` rnf arg `Prelude.seq` rnf args 28 | rnf (EPrimOp s args) = rnf s `Prelude.seq` rnf args 29 | rnf (EApp f args) = rnf f `Prelude.seq` rnf args 30 | rnf (ECase scrutinee branches) = rnf scrutinee `Prelude.seq` rnf branches 31 | rnf (ELet x e1 e2) = rnf x `Prelude.seq` rnf e1 `Prelude.seq` rnf e2 32 | rnf (ESeq e1 e2) = rnf e1 `Prelude.seq` rnf e2 33 | rnf (ELetRec binds e) = rnf binds `Prelude.seq` rnf e 34 | rnf (ETry e1 n1 e2 n2 e3) = rnf e1 `Prelude.seq` rnf n1 `Prelude.seq` rnf e2 `Prelude.seq` rnf n2 `Prelude.seq` rnf e3 35 | 36 | instance NFData Pat where 37 | rnf PVar = () 38 | rnf (PLit lit) = rnf lit 39 | rnf (PCons p1 p2) = rnf p1 `Prelude.seq` rnf p2 40 | rnf (PTuple ps) = rnf ps 41 | rnf (PMap pairs) = rnf pairs 42 | rnf PNil = () 43 | 44 | instance NFData Redex where 45 | rnf (RExp e) = rnf e 46 | rnf (RValSeq vs) = rnf vs 47 | rnf (RExc ex) = rnf ex 48 | rnf RBox = () 49 | 50 | instance NFData ExcClass where 51 | rnf Error = () 52 | rnf Throw = () 53 | rnf Exit = () 54 | 55 | instance NFData FrameIdent where 56 | rnf IValues = () 57 | rnf ITuple = () 58 | rnf IMap = () 59 | rnf (ICall v1 v2) = rnf v1 `Prelude.seq` rnf v2 60 | rnf (IPrimOp s) = rnf s 61 | rnf (IApp v) = rnf v 62 | 63 | instance NFData Frame where 64 | rnf (FCons1 e) = rnf e 65 | rnf (FCons2 v) = rnf v 66 | rnf (FParams fid vs es) = rnf fid `Prelude.seq` rnf vs `Prelude.seq` rnf es 67 | rnf (FApp1 es) = rnf es 68 | rnf (FCallMod e es) = rnf e `Prelude.seq` rnf es 69 | rnf (FCallFun v es) = rnf v `Prelude.seq` rnf es 70 | rnf (FCase1 branches) = rnf branches 71 | rnf (FCase2 vs e branches) = rnf vs `Prelude.seq` rnf e `Prelude.seq` rnf branches 72 | rnf (FLet i e) = rnf i `Prelude.seq` rnf e 73 | rnf (FSeq e) = rnf e 74 | rnf (FTry i1 e1 i2 e2) = rnf i1 `Prelude.seq` rnf e1 `Prelude.seq` rnf i2 `Prelude.seq` rnf e2 75 | 76 | instance NFData Signal where 77 | rnf (SMessage v) = rnf v 78 | rnf (SExit v b) = rnf v `Prelude.seq` rnf b 79 | rnf SLink = () 80 | rnf SUnlink = () 81 | 82 | instance NFData Action where 83 | rnf (ASend p1 p2 sig) = rnf p1 `Prelude.seq` rnf p2 `Prelude.seq` rnf sig 84 | rnf (AArrive p1 p2 sig)= rnf p1 `Prelude.seq` rnf p2 `Prelude.seq` rnf sig 85 | rnf (ASelf p) = rnf p 86 | rnf (ASpawn p v1 v2 b) = rnf p `Prelude.seq` rnf v1 `Prelude.seq` rnf v2 `Prelude.seq` rnf b 87 | rnf Coq__UU03c4_ = () 88 | rnf Coq__UU03b5_ = () 89 | 90 | -------------------------------------------------------------------------------- /Erl_codes/exception_tests.core: -------------------------------------------------------------------------------- 1 | module 'exception_tests' ['module_info'/0, 2 | 'module_info'/1, 3 | 'exception_list_hd'/0, 4 | 'exception_list_tl'/0, 5 | 'exception_tuple'/0, 6 | 'try_eval'/0, 7 | 'try_eval_catch'/0, 8 | 'try_eval_exception'/0, 9 | 'try_eval_exception2'/0, 10 | 'eval_case_pat_ex'/0, 11 | 'eval_case_clause_ex'/1, 12 | 'call_eval_body_ex'/0, 13 | 'call_eval_body_ex2'/0, 14 | 'call_eval_param_ex'/0, 15 | 'let_eval_exception_params'/0, 16 | 'let_eval_exception_body'/0, 17 | 'apply_eval_exception_closure'/0, 18 | 'apply_eval_exception_closure2'/0, 19 | 'apply_eval_exception_param'/0, 20 | 'apply_eval_exception_param_count'/0, 21 | 'apply_eval_exception_body'/0, 22 | 'letrec_exception'/0, 23 | 'map_eval_ex_key'/0, 24 | 'map_eval_ex_val'/0, 25 | 'seq_eval_ex_1'/0, 26 | 'seq_eval_ex_2'/0 27 | ] 28 | attributes [%% Line 1 29 | 'file' = 30 | %% Line 1 31 | [{[101|[120|[99|[101|[112|[116|[105|[111|[110|[95|[116|[101|[115|[116|[115|[46|[101|[114|[108]]]]]]]]]]]]]]]]]]],1}], 32 | %% Line 2 33 | 'compile' = 34 | %% Line 2 35 | ['export_all']] 36 | 'module_info'/0 = 37 | fun () -> 38 | call 'erlang':'get_module_info' 39 | ('exception_tests') 40 | 'module_info'/1 = 41 | fun (_0) -> 42 | call 'erlang':'get_module_info' 43 | ('exception_tests', _0) 44 | 45 | 'exception_list_hd'/0 = fun() -> [call 'erlang':'+'(5, {})|['error']] 46 | 47 | 'exception_list_tl'/0 = fun() -> ['error'|[call 'erlang':'+'(5, {})|['error']]] 48 | 49 | 'exception_tuple'/0 = fun() -> {'error', 'error', 'error', call 'erlang':'+'(5, {})} 50 | 51 | 'try_eval'/0 = fun() -> 52 | try {} of 53 | X -> 'ok' 54 | catch -> 'error' 55 | 56 | 57 | 'try_eval_catch'/0 = fun() -> 58 | try call 'erlang':'+'(5, {}) of 59 | X -> 'ok' 60 | catch -> 'error' 61 | 62 | 63 | 'try_eval_exception'/0 = fun() -> 64 | try call 'erlang':'+'(5, {}) of 65 | X -> 'ok' 66 | catch -> call 'erlang':'+'(5, {}) 67 | 68 | 69 | 'try_eval_exception2'/0 = fun() -> 70 | try {} of 71 | X -> call 'erlang':'+'(5, {}) 72 | catch -> 'error' 73 | 74 | 'eval_case_pat_ex'/0 = fun() -> 75 | case call 'erlang':'+'(5, {}) of 76 | when 'true' -> 1 77 | end 78 | 79 | 'eval_case_clause_ex'/1 = fun(Y) -> 80 | case Y of 81 | <1> when 'true' -> 1 82 | when 'false' -> 2 83 | end 84 | 85 | 86 | 'call_eval_body_ex'/0 = fun() -> 87 | call 'erlang':'+'() 88 | 89 | 'call_eval_body_ex2'/0 = fun() -> 90 | call 'erlang':'+'(5, {}) 91 | 92 | 'call_eval_param_ex'/0 = fun() -> 93 | call 'erlang':'+'(5, call 'erlang':'+'(5, {})) 94 | 95 | 'let_eval_exception_params'/0 = fun() -> 96 | let = <5, call 'erlang':'+'(5, {})> in {} 97 | 98 | 'let_eval_exception_body'/0 = fun() -> 99 | let = <5, 5> in call 'erlang':'+'(5, {}) 100 | 101 | 'apply_eval_exception_closure'/0 = fun() -> 102 | apply 4(5,5) 103 | 104 | 'apply_eval_exception_closure2'/0 = fun() -> 105 | apply call 'erlang':'+'(5, {})(5,5) 106 | 107 | 'apply_eval_exception_param'/0 = fun() -> 108 | let X = fun() -> 4 in 109 | apply X(call 'erlang':'+'(5, {})) 110 | 111 | 'apply_eval_exception_param_count'/0 = fun() -> 112 | let X = fun() -> 4 in 113 | apply X(2) 114 | 115 | 'apply_eval_exception_body'/0 = fun() -> 116 | let X = fun() -> call 'erlang':'+'(5, {}) in 117 | apply X() 118 | 119 | 'letrec_exception'/0 = fun() -> 120 | letrec 'fun1'/0 = fun() -> 'error' in call 'erlang':'+'(5, {}) 121 | 122 | 'map_eval_ex_key'/0 = fun() -> 123 | ~{'error' => 'error', 'error' => 'error', 124 | call 'erlang':'+'(5, {}) => 'error', 'error' => 'error'}~ 125 | 126 | 'map_eval_ex_val'/0 = fun() -> 127 | ~{'error' => 'error', 'error' => call 'erlang':'+'(5, {}), 128 | call 'erlang':'+'(5, {}) => 'error', 'error' => 'error'}~ 129 | 130 | 'seq_eval_ex_1'/0 = fun() -> 131 | do call 'erlang':'+'(5, {}) 42 132 | 133 | 'seq_eval_ex_2'/0 = fun() -> 134 | do 42 call 'erlang':'+'(5, {}) 135 | 136 | end -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/length.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testlength := ELetRec [(1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VLit (Integer (0))));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 6 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([PVar;(PCons PVar PVar)], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VVar 0));(VVal (VVar 3))])))));([PVar;PNil], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 7 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (4, 2))) [(VVal (VVar 0));(VVal VNil)])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 8 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([(PLit (Integer (0)));PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (6, 2))) [(VVal (VVar 0));(EExp (ECons (VVal (VLit (Integer (0)))) (VVal (VVar 2))))])))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 9 | (3, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10));(VVal (VVar 11))])) [([(PLit (Integer (0)));PVar;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 1)));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 1))) [(VVal (VVar 2))])) (EExp (EApp (VVal (VFunId (9, 3))) [(VVal (VVar 1));(VVal (VVar 3));(VVal (VVar 0))])))))));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2))]))])))]))); 10 | (1, (EExp (ECase (VVal (VVar 9)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VLit (Integer (20000))))])) (EExp (EApp (VVal (VFunId (5, 3))) [(VVal (VLit (Integer (50000))));(VVal (VVar 0));(VVal (VLit (Integer (0))))])))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 11 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "length"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 12 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 13 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (5, 1))) [VVal VNil]). 14 | 15 | 16 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/length2.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testlength2 := ELetRec [(1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VLit (Integer (0))));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 6 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([PVar;(PCons PVar PVar)], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VVar 0));(VVal (VVar 3))])))));([PVar;PNil], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 7 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (4, 2))) [(VVal (VVar 0));(VVal VNil)])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 8 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([(PLit (Integer (0)));PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (6, 2))) [(VVal (VVar 0));(EExp (ECons (VVal (VLit (Integer (0)))) (VVal (VVar 2))))])))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 9 | (3, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10));(VVal (VVar 11))])) [([(PLit (Integer (0)));PVar;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 1)));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 1))) [(VVal (VVar 2))])) (EExp (EApp (VVal (VFunId (9, 3))) [(VVal (VVar 1));(VVal (VVar 3));(VVal (VVar 0))])))))));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2))]))])))]))); 10 | (1, (EExp (ECase (VVal (VVar 9)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VLit (Integer (2000))))])) (EExp (EApp (VVal (VFunId (5, 3))) [(VVal (VLit (Integer (50000))));(VVal (VVar 0));(VVal (VLit (Integer (0))))])))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 11 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "length"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 12 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 13 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (5, 1))) [VVal VNil]). 14 | 15 | 16 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/length3.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testlength3 := ELetRec [(1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VLit (Integer (0))));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 6 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([PVar;(PCons PVar PVar)], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VVar 0));(VVal (VVar 3))])))));([PVar;PNil], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 7 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (4, 2))) [(VVal (VVar 0));(VVal VNil)])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 8 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([(PLit (Integer (0)));PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (6, 2))) [(VVal (VVar 0));(EExp (ECons (VVal (VLit (Integer (0)))) (VVal (VVar 2))))])))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 9 | (3, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10));(VVal (VVar 11))])) [([(PLit (Integer (0)));PVar;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 1)));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 1))) [(VVal (VVar 2))])) (EExp (EApp (VVal (VFunId (9, 3))) [(VVal (VVar 1));(VVal (VVar 3));(VVal (VVar 0))])))))));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2))]))])))]))); 10 | (1, (EExp (ECase (VVal (VVar 9)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VLit (Integer (20000))))])) (EExp (EApp (VVal (VFunId (5, 3))) [(VVal (VLit (Integer (5))));(VVal (VVar 0));(VVal (VLit (Integer (0))))])))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 11 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "length"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 12 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 13 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (5, 1))) [VVal VNil]). 14 | 15 | 16 | -------------------------------------------------------------------------------- /src/Concurrent/Ideas.md: -------------------------------------------------------------------------------- 1 | Lessons learned: 2 | - PIDsOf cannot be defined for the co-inductive representation of the process pool/ether - new fresh PIDs cannot be generated 3 | - Using functions for process pools is 4 | - simple for the definitions; 5 | - hard, if its properties (e.g., dom) are needed, for example for fresh variable generation. 6 | - Bisimulations 7 | - Playing with bisimulation in Erlang -> this paper only considers ethers 8 | and defines observations based on the "dangling" messages 9 | - The usual notion of bisimulations involves checking equality on actions, 10 | however, in this case we could not reason about systems using different 11 | PIDs (e.g., two systems could communicate on different input PIDs). 12 | - Bisimulations + bijective function on the PIDs? Drawback: we have to 13 | somehow rename all PIDs in signals/messages, which might be impossible 14 | for closure values (because they include a body expression which could 15 | contain e.g., "self()" calls, where the PID is not syntactically there). 16 | ^---- would be enough to observe the "type" of these actions? 17 | - How "deep" action parameters should be investigated? Should they 18 | be equivalent, or check only the type, or nothing? 19 | - Could we rename PIDs in the bisimilar systems for the first time, 20 | so that PID bijection is not needed (the currently existing PIDs 21 | of the system), and then suppose that the processes spawn with the same 22 | PIDs? <- probably not 23 | - Observable behaviour: signals exiting the system, but not the internal 24 | signals and communication -> unTaken PIDs should be observed in the ether 25 | - Strong bisimulation: the two systems have to do the same steps 26 | - I don't see a relation besides equality that could satisfy this 27 | - Weak bisimulation: the two systems have to do the same communication steps 28 | - Too restrictive to reason about systems that use a different number of 29 | communication steps (e.g., server that catches errors vs server that is 30 | re-created when errors occur) 31 | - "Barbed bisimulation": the two systems should produce the same signals to 32 | the outside world + the evolution of the systems should preserve the relation 33 | - Too many soft definitions in the papers - e.g., "used PID" 34 | - Does it include only dangling signals, or all used pids? 35 | 36 | - Does Lemma 1 (compatible reductions create compatible nodes) of Playing with Bisimulation in Erlang hold for us? e.g., 37 | (ether, ι ↦ ι' ! 'cat') -[arrive(exit, ι)]-> (ether, ι ↦ deadproc) 38 | (ether, ι ↦ ι' ! 'cat') -[send('cat', ι')]-> (ether ∪ {(ι, ι', 'cat')}, ι ↦ 'cat') 39 | 40 | - In Lanese et al., Lemma 9 does not hold for this semantics, 41 | because arrival can change the semantics of receive primops!!! 42 | E.g., recv_peek_message returns None for empty mailbox, while the 43 | first message if it is nonempty (and arrival can put a message into the 44 | empty mailbox). 45 | - Renaming 46 | - Concurrent renaming won't work with stdpp's map formalism - it is required for `kmap` that the function used for mapping is injective, 47 | while we use renaming to replace the spawned PID with a fresh PID, if it is used in the renaming (to avoid accidental capture in the renaming). E.g., 48 | 49 | 1 : P || 2 : Q || ∅ -[spawn 4]-> 1: P || 2: Q || 4: R || ∅ 50 | rename 3 into 4 51 | 1 : P || 2 : Q || ∅ -[spawn 5]-> 1: P || 2: Q || 5: R || ∅ 52 | 53 | the function `fun x => match x with | 3 => 4 | 4 => 5 | y => y end` used for this is not injective! 54 | - For sequential renaming, we need to use symmetrical renamings to preserve injectivity (for abstractions expressed with stdpp's maps - ethers, pools, dead processes). 55 | - Simulation equivalence vs bisimulation 56 | - The latter implies the former 57 | - Simulation equivalence is less restrictive 58 | - Confluence 59 | - There are a number of actions that affect the confluence of the process: 60 | - `'trap_exit'` flag, list of linked processes - if these are modified in one reduction, then an exit message can arrive in different ways before and after the modification. 61 | - If the mailbox is modified (e.g., by `remove_message`), then it potentially affects the semantics of other mailbox operations (e.g., `recv_peek_message` potentially fails after the removal). 62 | 63 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/nrev.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testnrev := ELetRec [(1, (EExp (ECase (VVal (VVar 9)) [([(PCons PVar PVar)], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VVar 1))])) (EExp (EApp (VVal (VFunId (4, 2))) [(VVal (VVar 0));(EExp (ECons (VVal (VVar 1)) (VVal VNil)))])))));([PNil], (VVal (VLit (Atom "true"%string))), (VVal VNil));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 6 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([(PCons PVar PVar);PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 2))) [(VVal (VVar 1));(VVal (VVar 2))])) (EExp (ECons (VVal (VVar 1)) (VVal (VVar 0)))))));([PNil;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 7 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (4, 2))) [(VVal (VVar 0));(VVal VNil)])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 8 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([(PLit (Integer (0)));PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (6, 2))) [(VVal (VVar 0));(EExp (ECons (VVal (VVar 1)) (VVal (VVar 2))))])))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 9 | (3, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10));(VVal (VVar 11))])) [([(PLit (Integer (0)));PVar;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 1)));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 1))) [(VVal (VVar 2))])) (EExp (EApp (VVal (VFunId (9, 3))) [(VVal (VVar 1));(VVal (VVar 3));(VVal (VVar 0))])))))));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2))]))])))]))); 10 | (1, (EExp (ECase (VVal (VVar 9)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VLit (Integer (1000))))])) (EExp (EApp (VVal (VFunId (5, 3))) [(VVal (VLit (Integer (1500))));(VVal (VVar 0));(VVal (VLit (Integer (0))))])))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 11 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "nrev"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 12 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "nrev"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 13 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "nrev"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (5, 1))) [VVal VNil]). 14 | 15 | 16 | -------------------------------------------------------------------------------- /src/Interpreter/HaskellExtractionQuickCheck.v: -------------------------------------------------------------------------------- 1 | Require Coq.extraction.Extraction. 2 | Extraction Language Haskell. 3 | 4 | From CoreErlang.Interpreter Require Import StepFunctions. 5 | From CoreErlang.Interpreter Require Import Scheduler. 6 | From CoreErlang.Interpreter.ExampleASTs.coqAST Require Import decode fib huff length length2 length_c length_u life life2 life3 mean_nnc nrev qsort ring smith stable stable2 tak zip_nnc life4 pmap length3. 7 | 8 | Definition examplePrograms : list Redex := 9 | [RExp testdecode; RExp testfib; RExp testhuff; RExp testlength; RExp testlength2; 10 | RExp testlength_c; RExp testlength_u; RExp testlife; RExp testlife2; RExp testlife3; 11 | RExp testmean_nnc; RExp testnrev; RExp testqsort; RExp testring; RExp testsmith; 12 | RExp teststable; RExp teststable2; RExp testtak; RExp testzip_nnc; RExp testlife4; RExp testpmap; RExp testlength3]. 13 | 14 | Require Import ExtrHaskellBasic. 15 | Require Import ExtrHaskellNatInteger. 16 | Require Import ExtrHaskellZInteger. 17 | Require Import ExtrHaskellString. 18 | 19 | Extract Inlined Constant app => "(Prelude.++)". 20 | Extract Inlined Constant length => "(Data.List.genericLength)". 21 | 22 | Extract Inlined Constant Pos.succ => "(Prelude.+ 1)". 23 | Extract Inlined Constant Pos.succ_of_nat => "(Prelude.+ 1)". (** doesn't work?? *) 24 | Extract Inlined Constant fst => "Prelude.fst". 25 | Extract Inlined Constant snd => "Prelude.snd". 26 | Extract Inlined Constant uncurry => "Prelude.uncurry". 27 | Extract Inlined Constant prod_rect => "Prelude.uncurry". 28 | Extract Inlined Constant unit_rec => "Prelude.const". 29 | Extract Inlined Constant Pos.add => "(Prelude.+)". 30 | 31 | (* Operations for extracting gsets and gmaps into HashSets and HashMaps *) 32 | Extract Inlined Constant fold_right => "Prelude.foldr". 33 | (* 34 | Extract Constant dead_lookup => "Data.HashMap.Strict.lookup". 35 | Extract Constant dead_delete => "Data.HashMap.Strict.delete". 36 | Extract Constant dead_domain => "Data.HashMap.Strict.keysSet". 37 | Extract Constant dead_size => "(\dead -> Prelude.toInteger (Data.HashMap.Strict.size dead))". 38 | Extract Constant pids_set_to_map => 39 | "(\v s -> Data.HashMap.Strict.fromList [(k, v) | k <- Data.HashSet.toList s])". 40 | Extract Constant pids_insert => "Data.HashSet.insert". 41 | Extract Constant pids_delete => "Data.HashSet.delete". 42 | Extract Constant pids_empty => "Data.HashSet.empty". 43 | Extract Constant pids_member => "Data.HashSet.member". 44 | Extract Constant pids_union => "Data.HashSet.union". 45 | Extract Constant pids_singleton => "Data.HashSet.singleton". 46 | Extract Constant pids_toList => "Data.HashSet.toList". 47 | Extract Constant pids_fresh => 48 | "(\pids -> if Data.HashSet.null pids then 0 else (Prelude.maximum (Data.HashSet.toList pids) Prelude.+ 1))". 49 | Extract Constant pids_foldWithKey => "Data.HashMap.Strict.foldrWithKey'". (* note the apostrophy *) 50 | Extract Constant pids_map_set_union => "(\f m -> Data.HashSet.unions [f k v | (k, v) <- Data.HashMap.Strict.toList m])". 51 | Extract Constant pool_singleton => "Data.HashMap.Strict.singleton". 52 | Extract Constant pool_lookup => "Data.HashMap.Strict.lookup". 53 | Extract Constant pool_insert => "Data.HashMap.Strict.insert". 54 | Extract Constant pool_toList => "Data.HashMap.Strict.toList". 55 | Extract Constant pool_domain => "Data.HashMap.Strict.keysSet". 56 | Extract Constant ether_empty => "Data.HashMap.Strict.empty". 57 | Extract Constant ether_lookup => "Data.HashMap.Strict.lookup". 58 | Extract Constant ether_insert => "Data.HashMap.Strict.insert". 59 | Extract Constant ether_toList => "Data.HashMap.Strict.toList". 60 | Extract Constant ether_domain_toList => "(\eth -> Data.HashSet.toList (Data.HashMap.Strict.keysSet eth))". 61 | *) 62 | 63 | Extract Inlined Constant Val_eqb_strict => "(Prelude.==)". 64 | Extract Inlined Constant Exp_eqb_strict => "(Prelude.==)". 65 | Extract Inlined Constant Signal_eqb_strict => "(Prelude.==)". 66 | 67 | Extract Inlined Constant map => "(Prelude.map)". 68 | 69 | Extract Constant subst => 70 | " 71 | (\_UU03be_ base -> 72 | case base of { 73 | VVal v -> 74 | let v' = (substVal _UU03be_ v) 75 | in v' `deepseq` VVal v'; 76 | EExp e -> 77 | let e' = (substNonVal _UU03be_ e) 78 | in e' `deepseq` EExp e'}) 79 | ". 80 | 81 | Extraction "HaskellSrc/QuickCheck/CoqExtractionRaw.hs" 82 | substVal substNonVal 83 | nodeTauFirstStep makeInitialNode makeInitialConfig currentProcessList 84 | nodeSimpleStep interProcessStepFuncFast ex_Process 85 | isDead isTotallyDead etherNonEmpty. -------------------------------------------------------------------------------- /src/Interpreter/OCamlExtraction.v: -------------------------------------------------------------------------------- 1 | Require Coq.extraction.Extraction. 2 | Extraction Language OCaml. 3 | 4 | From CoreErlang.Interpreter Require Import StepFunctions. 5 | From CoreErlang.Interpreter Require Import Scheduler. 6 | From CoreErlang.Interpreter.ExampleASTs.coqAST Require Import decode fib huff length length2 length_c length_u life life2 life3 mean_nnc nrev qsort ring smith stable stable2 tak zip_nnc life4. 7 | 8 | Definition examplePrograms : list Redex := 9 | [RExp testdecode; RExp testfib; RExp testhuff; RExp testlength; RExp testlength2; 10 | RExp testlength_c; RExp testlength_u; RExp testlife; RExp testlife2; RExp testlife3; 11 | RExp testmean_nnc; RExp testnrev; RExp testqsort; RExp testring; RExp testsmith; 12 | RExp teststable; RExp teststable2; RExp testtak; RExp testzip_nnc; RExp testlife4]. 13 | 14 | Require Import ExtrOcamlBasic. 15 | Require Import ExtrOcamlNatInt. 16 | Require Import ExtrOcamlZInt. 17 | Require Import ExtrOcamlString. 18 | 19 | Extract Inlined Constant pool_singleton => "(PIDMap.singleton)". 20 | Extract Inlined Constant pool_lookup => "(PIDMap.find_opt)". 21 | Extract Inlined Constant pool_insert => "(PIDMap.add)". 22 | Extract Inlined Constant pool_toList => "(PIDMap.bindings)". 23 | 24 | Extract Inlined Constant ether_empty => "(PIDPIDMap.empty)". 25 | Extract Inlined Constant ether_lookup => "(PIDPIDMap.find_opt)". 26 | Extract Inlined Constant ether_insert => "(PIDPIDMap.add)". 27 | Extract Inlined Constant ether_toList => "(PIDPIDMap.bindings)". 28 | Extract Inlined Constant ether_domain_toList => "(fun eth -> List.map fst (PIDPIDMap.bindings eth))". 29 | 30 | Extract Inlined Constant Val_eqb_strict => "(=)". 31 | Extract Inlined Constant Exp_eqb_strict => "(=)". 32 | Extract Inlined Constant Pos.succ => "(Stdlib.Int.succ)". 33 | 34 | (** 35 | This is a VERY dirty trick, and it's only left here because the OCaml Interpreter is essentially 36 | deprecated. The reason for this is as follows: in the usedPIDsProc function (ProcessSemantics.v), 37 | two methods are given for the PIDs of dead processes. A new version of this function was created 38 | in InterpreterAux, for the wrapper functions of map and set operation. 39 | 40 | In the Haskell version, all maps and sets were swapped to Haskell's HashMaps and HashSets (see 41 | HaskellExtraction.v). However, in the OCaml version, only the Ether and the ProcessPool was swapped. 42 | The reason for this is that there is no general way to swap every "intermediate" form, such as a 43 | set of PIDs. This is because of the type annotations that the extraction adds. The syntax just makes 44 | it (probably?) impossible. 45 | 46 | When the new usedPIDsProc function was initially defined in InterpreterAux.v, the old version method 47 | of dead process PIDs was used: 48 | 49 | "map_fold (fun k x acc => {[k]} ∪ usedPIDsVal x ∪ acc) ∅ links" 50 | 51 | This works during the extraction to OCaml. However, it could not be proven that this behaves 52 | equivalently to the new method, defined just below it: 53 | 54 | "@union_set _ _ _ gsetPID_elem_of _ (map_to_set (fun k x => {[k]} ∪ usedPIDsVal x) links)" 55 | 56 | Therefore, this new version was used in the wrapper function for usedPIDsProc. This is no problem when 57 | we're extracting into Haskell, however it is a problem for OCaml. A wrapper function inside this 58 | (pids_map_set_union) is extracted into OCaml and it does NOT get replaced. This pids_map_set_union 59 | function calls "gsetPID_elem_of", and ocamlc seems to not understand the type declaration of that. 60 | This is either a bug with the extraction to OCaml, or a bug inside ocamlc itself. 61 | 62 | The fix is very dirty. We replace pids_map_set_union with the old version of the function. However, 63 | the interfaces are not compatible (see the type declarations for pids_map_set_union and pids_foldWithKey), 64 | so we need a lambda that throws away the old function, but keeps the links. So we are essentially 65 | using the old version of the function. Node that during the extraction, we need to manually add 66 | pids_foldWithKey, as it does not get extracted on it's own when it's in a manual replacement. 67 | *) 68 | Extract Inlined Constant pids_map_set_union => 69 | "(fun _ l -> pids_foldWithKey (fun k x acc -> 70 | pids_union (pids_insert k (usedPIDsValNew x)) acc) pids_empty l)". 71 | 72 | Extraction "OCamlSrc/CoqExtraction.ml" 73 | pids_foldWithKey (* To see why this is here, read the comment for "pids_map_set_union" above. *) 74 | nodeSimpleStep interProcessStepFuncFast makeInitialNodeConf ex_Process 75 | isDead isTotallyDead etherNonEmpty 76 | currPID nextConf newConfByAction delCurrFromConf 77 | examplePrograms. -------------------------------------------------------------------------------- /src/Interpreter/HaskellExtraction.v: -------------------------------------------------------------------------------- 1 | Require Coq.extraction.Extraction. 2 | Extraction Language Haskell. 3 | 4 | From CoreErlang.Interpreter Require Import StepFunctions. 5 | From CoreErlang.Interpreter Require Import Scheduler. 6 | From CoreErlang.Interpreter.ExampleASTs.coqAST Require Import decode fib huff length length2 length_c length_u life life2 life3 mean_nnc nrev qsort ring smith stable stable2 tak zip_nnc life4 pmap length3. 7 | 8 | Definition examplePrograms : list Redex := 9 | [RExp testdecode; RExp testfib; RExp testhuff; RExp testlength; RExp testlength2; 10 | RExp testlength_c; RExp testlength_u; RExp testlife; RExp testlife2; RExp testlife3; 11 | RExp testmean_nnc; RExp testnrev; RExp testqsort; RExp testring; RExp testsmith; 12 | RExp teststable; RExp teststable2; RExp testtak; RExp testzip_nnc; RExp testlife4; RExp testpmap; RExp testlength3]. 13 | 14 | Require Import ExtrHaskellBasic. 15 | Require Import ExtrHaskellNatInteger. 16 | Require Import ExtrHaskellZInteger. 17 | Require Import ExtrHaskellString. 18 | 19 | Extract Inlined Constant app => "(Prelude.++)". 20 | Extract Inlined Constant length => "(Data.List.genericLength)". 21 | 22 | Extract Inlined Constant Pos.succ => "(Prelude.+ 1)". 23 | Extract Inlined Constant Pos.succ_of_nat => "(Prelude.+ 1)". (** doesn't work?? *) 24 | Extract Inlined Constant fst => "Prelude.fst". 25 | Extract Inlined Constant snd => "Prelude.snd". 26 | Extract Inlined Constant uncurry => "Prelude.uncurry". 27 | Extract Inlined Constant prod_rect => "Prelude.uncurry". 28 | Extract Inlined Constant unit_rec => "Prelude.const". 29 | Extract Inlined Constant Pos.add => "(Prelude.+)". 30 | 31 | (* Operations for extracting gsets and gmaps into HashSets and HashMaps *) 32 | Extract Inlined Constant fold_right => "Prelude.foldr". 33 | Extract Inlined Constant dead_lookup => "Data.HashMap.Strict.lookup". 34 | Extract Inlined Constant dead_delete => "Data.HashMap.Strict.delete". 35 | Extract Inlined Constant dead_domain => "Data.HashMap.Strict.keysSet". 36 | Extract Inlined Constant dead_size => "(\dead -> Prelude.toInteger (Data.HashMap.Strict.size dead))". 37 | Extract Inlined Constant pids_set_to_map => 38 | "(\v s -> Data.HashMap.Strict.fromList [(k, v) | k <- Data.HashSet.toList s])". 39 | Extract Inlined Constant pids_insert => "Data.HashSet.insert". 40 | Extract Inlined Constant pids_delete => "Data.HashSet.delete". 41 | Extract Inlined Constant pids_empty => "Data.HashSet.empty". 42 | Extract Inlined Constant pids_member => "Data.HashSet.member". 43 | Extract Inlined Constant pids_union => "Data.HashSet.union". 44 | Extract Inlined Constant pids_singleton => "Data.HashSet.singleton". 45 | Extract Inlined Constant pids_toList => "Data.HashSet.toList". 46 | Extract Inlined Constant pids_fresh => 47 | "(\pids -> if Data.HashSet.null pids then 0 else (Prelude.maximum (Data.HashSet.toList pids) Prelude.+ 1))". 48 | Extract Inlined Constant pids_foldWithKey => "Data.HashMap.Strict.foldrWithKey'". (* note the apostrophy *) 49 | Extract Inlined Constant pids_map_set_union => "(\f m -> Data.HashSet.unions [f k v | (k, v) <- Data.HashMap.Strict.toList m])". 50 | Extract Inlined Constant pool_singleton => "Data.HashMap.Strict.singleton". 51 | Extract Inlined Constant pool_lookup => "Data.HashMap.Strict.lookup". 52 | Extract Inlined Constant pool_insert => "Data.HashMap.Strict.insert". 53 | Extract Inlined Constant pool_toList => "Data.HashMap.Strict.toList". 54 | Extract Inlined Constant pool_domain => "Data.HashMap.Strict.keysSet". 55 | Extract Inlined Constant ether_empty => "Data.HashMap.Strict.empty". 56 | Extract Inlined Constant ether_lookup => "Data.HashMap.Strict.lookup". 57 | Extract Inlined Constant ether_insert => "Data.HashMap.Strict.insert". 58 | Extract Inlined Constant ether_toList => "Data.HashMap.Strict.toList". 59 | Extract Inlined Constant ether_domain_toList => "(\eth -> Data.HashSet.toList (Data.HashMap.Strict.keysSet eth))". 60 | 61 | Extract Inlined Constant Val_eqb_strict => "(Prelude.==)". 62 | Extract Inlined Constant Exp_eqb_strict => "(Prelude.==)". 63 | Extract Inlined Constant Signal_eqb_strict => "(Prelude.==)". 64 | 65 | Extract Inlined Constant map => "(Prelude.map)". 66 | 67 | Extract Constant subst => 68 | " 69 | (\_UU03be_ base -> 70 | case base of { 71 | VVal v -> 72 | let v' = (substVal _UU03be_ v) 73 | in v' `deepseq` VVal v'; 74 | EExp e -> 75 | let e' = (substNonVal _UU03be_ e) 76 | in e' `deepseq` EExp e'}) 77 | ". 78 | 79 | Extraction "HaskellSrc/exe/CoqExtraction.hs" 80 | substVal substNonVal 81 | nodeTauFirstStep makeInitialNode makeInitialConfig currentProcessList 82 | nodeSimpleStep interProcessStepFuncFast ex_Process 83 | isDead isTotallyDead etherNonEmpty. -------------------------------------------------------------------------------- /src/Interpreter/HaskellSrc/exe/Scheduler.hs: -------------------------------------------------------------------------------- 1 | module Scheduler where 2 | 3 | import CoqExtraction 4 | import Data.List 5 | 6 | (!?) :: [a] -> Int -> Maybe a 7 | xs !? n 8 | | n < 0 = Nothing 9 | | otherwise = foldr (\x r k -> case k of 10 | 0 -> Just x 11 | _ -> r (k-1)) (const Nothing) xs n 12 | 13 | -- isEmpty : True if there are no processes to be scheduled, false otherwise 14 | -- addPID : Add a PID of a process to the schedule (not used directly in the interpreter) 15 | -- removePID : Remove a PID of a process from the schedule (used when processes terminate completely) 16 | -- changeByAction : Gets the PID of the process, a boolean whether the process is dead or not 17 | -- (True if dead, False if alive), and the action that was performed on it. 18 | -- The PID is given, because tau and epsilon steps do not contain it. The internal 19 | -- changes to the schedule should be decided by the developer. 20 | -- getOperation : Gives back a new scheduler, along with a potential operation to be taken. 21 | -- If no steps can be taken (e.g. the scheduler is empty), Nothing should be given. 22 | -- Otherwise, a single PID can be given to perform a non-arrival action to the process 23 | -- assigned to it, or a pair of PIDs to make a signal arrive from a source to a destination. 24 | -- Note that signals in the Ether should be accounted for by the developer. 25 | -- With changeByAction, an ASend action means that a signal was sent to the Ether, but it 26 | -- has not arrived yet. 27 | class (Show a, Eq a) => Scheduler a where 28 | isEmpty :: a -> Bool 29 | addPID :: a -> PID -> a 30 | removePID :: a -> PID -> a 31 | changeByAction :: a -> PID -> Bool -> Action -> a 32 | getOperation :: a -> (a, Maybe (Either PID (PID, PID))) 33 | 34 | -- This is a variation of round-robin scheduling. Note that it differs from the classic 35 | -- implementation in that new processes get inserted to a fixed point of the cycle. 36 | -- The scheduler takes K non-arrival steps on a single process, then delivers all 37 | -- signals in the Ether, and then moves on to the next process. If an ASpawn action 38 | -- was taken, the new process' PID gets put into the cycle. If an ASend action was taken, 39 | -- the (src, dst) pair is remembered. 40 | 41 | -- The first Int is the original K, the secong Int is the amount of steps left from K, 42 | -- [PID] is the list of PIDs to be scheduled, [(PID, PID)] is the source-destination 43 | -- pair list of signals floating in the Ether, and the last Int is a pointer to the 44 | -- list of PIDs in the scheduler. 45 | data RoundRobin = RoundRobin Int Int [PID] [(PID, PID)] Int 46 | deriving (Eq, Show) 47 | 48 | rrInit :: Int -> RoundRobin 49 | rrInit k = RoundRobin k k [] [] 0 50 | 51 | rrIsEmpty :: RoundRobin -> Bool 52 | rrIsEmpty (RoundRobin _ _ l _ _) = null l 53 | 54 | rrAddPID :: RoundRobin -> PID -> RoundRobin 55 | rrAddPID (RoundRobin k i l s ind) pid = 56 | case find (== pid) l of 57 | Nothing -> RoundRobin k i (pid : l) s (ind + 1) 58 | Just _ -> RoundRobin k i l s ind 59 | 60 | rrRemovePID :: RoundRobin -> PID -> RoundRobin 61 | rrRemovePID (RoundRobin k i l s ind) pid = 62 | case find (== pid) l of 63 | Just _ -> RoundRobin k i (delete pid l) s (ind - 1) 64 | Nothing -> RoundRobin k i l s ind 65 | 66 | rrAddSig :: RoundRobin -> (PID, PID) -> RoundRobin 67 | rrAddSig (RoundRobin k i l s ind) pids = 68 | RoundRobin k i l (pids : s) ind 69 | 70 | rrChangeByAction :: RoundRobin -> PID -> Bool -> Action -> RoundRobin 71 | rrChangeByAction rr _ _ action = 72 | case action of 73 | ASpawn pid _ _ _ -> rrAddPID rr pid 74 | ASend src dst _ -> rrAddSig rr (src, dst) 75 | _ -> rr 76 | 77 | rrGetOperation :: RoundRobin -> (RoundRobin, Maybe (Either PID (PID, PID))) 78 | rrGetOperation (RoundRobin k i l s ind) = 79 | if (i > 0) 80 | then case l !? ind of 81 | Just pid -> (RoundRobin k (i-1) l s ind, Just $ Left $ pid) 82 | Nothing -> (RoundRobin k i l s ind, Nothing) 83 | else case s of 84 | [] -> 85 | let ind' = (if ind == (Data.List.length l - 1) then 0 else (ind + 1)) in 86 | case l !? ind' of 87 | Just pid -> (RoundRobin k (k-1) l s ind', Just $ Left $ pid) 88 | Nothing -> (RoundRobin k (k-1) l s ind', Nothing) 89 | [s'] -> 90 | let ind' = (if ind == (Data.List.length l - 1) then 0 else (ind + 1)) in 91 | (RoundRobin k k l [] ind', Just $ Right $ s') 92 | (s' : ss) -> 93 | (RoundRobin k i l ss ind, Just $ Right $ s') 94 | 95 | instance Scheduler RoundRobin where 96 | isEmpty = rrIsEmpty 97 | addPID = rrAddPID 98 | removePID = rrRemovePID 99 | changeByAction = rrChangeByAction 100 | getOperation = rrGetOperation 101 | 102 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/mean_nnc.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testmean_nnc := ELetRec [(1, (EExp (ECase (VVal (VVar 10)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "math"%string))) (VVal (VLit (Atom "pi"%string))) [])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (3, 2))) [(VVal (VVar 1));(VVal (VVar 0))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (6, 1))) [(VVal (VVar 0))])) (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "/"%string))) [(VVal (VVar 0));(VVal (VVar 3))])))))))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 6 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 10));(VVal (VVar 11))])) [([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (4, 3))) [(VVal (VVar 0));(VVal (VVar 1));(VVal VNil)])));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 7 | (3, (EExp (ECase (EExp (EValues [(VVal (VVar 10));(VVal (VVar 11));(VVal (VVar 12))])) [([(PLit (Integer (0)));PVar;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 1)));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (6, 3))) [(VVal (VVar 0));(VVal (VVar 2));(EExp (ECons (VVal (VVar 2)) (VVal (VVar 3))))])))));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2))]))])))]))); 8 | (1, (EExp (ECase (VVal (VVar 10)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VVar 0));(VVal (VLit (Integer (0))))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 9 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 10));(VVal (VVar 11))])) [([PNil;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([(PCons PVar PVar);PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VVar 2))])) (EExp (EApp (VVal (VFunId (8, 2))) [(VVal (VVar 2));(VVal (VVar 0))])))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 10 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 10));(VVal (VVar 11))])) [([(PLit (Integer (0)));PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (3, 1))) [(VVal (VLit (Integer (10000000))))])) (EExp (EApp (VVal (VFunId (9, 2))) [(VVal (VVar 1));(VVal (VVar 0))])))))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 11 | (1, (EExp (ECase (VVal (VVar 10)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VLit (Integer (1))));(VVal (VLit (Integer (0))))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 12 | (1, (EExp (ECase (VVal (VVar 10)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "mean_nnc"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 13 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "mean_nnc"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 14 | (1, (EExp (ECase (VVal (VVar 10)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "mean_nnc"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (6, 1))) [VVal VNil]). 15 | 16 | 17 | -------------------------------------------------------------------------------- /Erl_codes/b.core: -------------------------------------------------------------------------------- 1 | module 'b' ['module_info'/0, 2 | 'module_info'/1, 3 | 'fun1'/0, 4 | 'fun2'/0, 5 | 'fun3'/0, 6 | 'fun5'/2, 7 | 'fun4'/0, 8 | 'fun6'/0, 9 | 'fun7'/0, 10 | 'fun7'/1, 11 | 'fun8'/0, 12 | 'fun9'/0, 13 | 'fun10'/0, 14 | 'fun11'/0, 15 | 'fun12'/0, 16 | 'fun13'/1, 17 | 'fun14'/0, 18 | 'fun15'/0, 19 | 'fun16'/0, 20 | 'g'/0, 21 | 'exp'/0, 22 | 'mapex'/0, 23 | 'infex'/0] 24 | attributes [%% Line 1 25 | 'file' = 26 | %% Line 1 27 | [{[98|[46|[101|[114|[108]]]]],1}]] 28 | 'module_info'/0 = 29 | fun () -> 30 | call 'erlang':'get_module_info' 31 | ('b') 32 | 'module_info'/1 = 33 | fun (_0) -> 34 | call 'erlang':'get_module_info' 35 | ('b', _0) 36 | 37 | 'mapex'/0 = 38 | fun() -> 39 | letrec 'map'/2 = fun(F, L) -> 40 | case L of 41 | <[]> when 'true' -> [] 42 | <[H|T]> when 'true' -> [apply F(H) | apply 'map'/2(F, T)] 43 | end 44 | in apply 'map'/2(fun(X) -> call 'erlang':'+'(X, 1), [1,2,3]) 45 | 46 | 'infex'/0 = 47 | fun() -> 48 | letrec 'f'/1 = fun(X) -> 49 | do call 'io':'fwrite'("~w",[X]) 50 | apply 'f'/1(call 'erlang':'+'(X, 1)) 51 | in 52 | apply 'f'/1(0) 53 | 54 | 'unexp'/0 = fun() -> 0 55 | 'exp'/0 = fun() -> call 'b':'unexp'() 56 | 57 | 'g'/0 = fun() -> do call 'erlang':'!'(call 'erlang':'self'(), 1) 58 | do call 'erlang':'!'(call 'erlang':'self'(), 2) 59 | do call 'erlang':'!'(call 'erlang':'self'(), 3) 60 | do call 'timer':'sleep'(0) 61 | try 62 | receive 3 when call 'erlang':'/'(2, 0) -> 'yougotme' after 'infinity' -> 0 63 | of -> X 64 | catch 65 | -> %%do call 'timer':'sleep'(0) 66 | {X_c, Y, Z, 67 | {receive XX when 'true' -> XX after 0 -> 'noval', 68 | receive XX when 'true' -> XX after 0 -> 'noval', 69 | receive XX when 'true' -> XX after 0 -> 'noval', 70 | receive XX when 'true' -> XX after 0 -> 'noval'}} 71 | 72 | 'fun1'/0 = 73 | fun() -> 74 | % case 75 | % {<2, 3>, 4} 76 | % of 77 | % {W, Q} when 'true' -> W 78 | % Q when 'true' -> 5 79 | % end 80 | % let = let = < <3, 4>, 6> in W in {X, Y} 81 | % {<3>, <4>, <5>} 82 | % let = 5, fun() -> 5, fun() -> 5> in {X, Y, Z} 83 | % let X = fun() -> <3, 4, 5> in let = apply X() in {Y, Z, W} 84 | % let = 85 | % case 5 of 86 | % 5 when 'true' -> <2> 87 | % X when 'true' -> 1 88 | % end 89 | % in 90 | % {X, X} 91 | %[3, <>, 5] 92 | %do <3, 4, 5> 93 | 4 94 | 95 | 96 | 'fun2'/0 = 97 | fun() -> 98 | try primop 'match_fail'({'asd', 1,2,3}) of 99 | X -> 'ok' 100 | catch -> {Ex1, Ex2, Ex3, primop 'get_hd'([1,2,3,4])} 101 | 102 | 'fun3'/0 = 103 | fun() -> let Y = [let X = 1 in X | [let X = 2 in X]] in Y 104 | 105 | 'fun5'/2 = 106 | fun(X, Y) -> %%{X,Y} 107 | [call 'erlang':'+'(X,Y) | [call 'erlang':'-'(X,Y) | [call 'erlang':'*'(X,Y) | []]]] 108 | 109 | 'fun4'/0 = 110 | fun() -> apply 'fun5'/2(let X = 7 in X,let X = 3 in 3) 111 | 112 | 'fun6'/0 = 113 | fun() -> let X = 5 in 114 | let X = fun(X, Y) -> X in apply X(4,fun() -> 5) 115 | 'fun7'/0 = 116 | fun() -> fun() -> 5 117 | 118 | 'fun7'/1 = 119 | fun(X) -> let Y = fun() -> 5 in let Y = fun(A) -> A in apply Y() 120 | 121 | 'fun8'/0 = 122 | fun() -> let X = 5 in let = <3,4,X> in Y 123 | 124 | 'fun9'/0 = 125 | fun() -> let Y = fun() -> 5 in let Z = 5 in apply Y() 126 | 127 | 'fun10'/0 = 128 | fun() -> let X = 42 in let Y = fun(X) -> X in let X = 5 in apply Y(7) 129 | 130 | 'fun11'/0 = 131 | fun() -> let X = 5 in let X = fun() -> X in apply X() 132 | 'fun12'/0 = 133 | fun() -> ~{{2, 6} => 5, ~{}~ => 4, ~{3 => 5}~ => 4, fun() -> 5 => 6, call 'erlang':'+'(3,4) => 2}~ 134 | 135 | 'fun13'/1 = 136 | fun(X) -> case X of 137 | <5> when 'true' -> 5 138 | <6> when 'true' -> 6 139 | <{Y, Z}> when call 'erlang':'=='(X, {6, 7}) -> Z 140 | <[Z | [Y]]> when 'true' -> Y 141 | end 142 | 143 | 'fun14'/0 = 144 | fun() -> let X = 5 in 145 | letrec 'fun14'/0 = fun() -> X 146 | 'b'/1 = fun(Z) -> case Z of 147 | <1> when 'true' -> 0 148 | when 'true' -> apply 'b'/1(call 'erlang':'-' (N, 1)) 149 | end 150 | in apply 'b'/1(15) 151 | 152 | 'fun15'/0 = 153 | fun () -> 154 | { call 'io':'format' ([72|[101|[108|[108|[111]]]]]), call 'erlang':'/' (1,0), call 'io':'format' ([72|[101|[108|[108|[111]]]]])} 155 | 156 | 'fun16'/0 = 157 | fun() -> let X = 5 in 158 | let X = fun() -> X in 159 | let X = fun() -> apply X() in 160 | let X = fun() -> apply X() in 161 | apply X() 162 | end 163 | -------------------------------------------------------------------------------- /src/Interpreter/OCamlSrc/interpreter.ml: -------------------------------------------------------------------------------- 1 | open CoqExtraction 2 | 3 | (* Mutable state to hold ((node, rr_config), pid) *) 4 | type node_state = { 5 | mutable p_node : node; 6 | mutable conf : rRConfig; 7 | mutable hipid : pID; 8 | mutable msgs : (pID * pID) list; 9 | } 10 | 11 | let example_for_exec = makeInitialNodeConf (RExp (EExp testlife4)) 12 | 13 | (* Create initial state *) 14 | let state = { 15 | p_node = fst (fst (fst example_for_exec)); 16 | conf = snd (fst (fst example_for_exec)); 17 | hipid = snd (fst example_for_exec); 18 | msgs = snd example_for_exec; 19 | } 20 | 21 | let rest = function 22 | | [] -> [] 23 | | x :: xs -> xs 24 | 25 | let action_to_msg_pids act = 26 | match act with 27 | | ASend (ps, pd, _) -> Some (ps, pd) 28 | | _ -> None 29 | 30 | let string_of_lit l = 31 | match l with 32 | | Atom chars -> 33 | "Atom('" ^ (String.concat "" (List.map (String.make 1) chars)) ^ "')" 34 | | Integer i -> 35 | Printf.sprintf "Integer(%d)" i 36 | 37 | let rec string_of_val v = 38 | match v with 39 | | VNil -> "VNil" 40 | | VLit lit -> "VLit(" ^ string_of_lit lit ^ ")" 41 | | VPid pid -> Printf.sprintf "VPid(P%d)" pid 42 | | VCons (v1, v2) -> 43 | "VCons(" ^ string_of_val v1 ^ ", " ^ string_of_val v2 ^ ")" 44 | | VTuple lst -> 45 | "VTuple([" ^ 46 | String.concat ", " (List.map string_of_val lst) ^ 47 | "])" 48 | | VMap kvs -> 49 | "VMap({" ^ 50 | String.concat ", " 51 | (List.map (fun (k, v) -> 52 | string_of_val k ^ " -> " ^ string_of_val v 53 | ) kvs) ^ 54 | "})" 55 | | VVar var_id -> Printf.sprintf "VVar(x%d)" var_id 56 | | VFunId (i, j) -> Printf.sprintf "VFunId(%d, %d)" i j 57 | | VClos _ -> "VClos()" 58 | 59 | let string_of_signal s = 60 | match s with 61 | | SMessage v -> "SMessage " ^ string_of_val v 62 | | SExit (v, b) -> "SExit " ^ string_of_val v ^ " " ^ string_of_bool b 63 | | SLink -> "SLink" 64 | | SUnlink -> "SUnlink" 65 | 66 | let display_action pid = function 67 | | Coq__UU03c4_ -> () 68 | | Coq__UU03b5_ -> 69 | Printf.printf "(P%d) eps\n" pid 70 | | ASelf _ -> () 71 | | ASend (ps, pd, signal) -> 72 | Printf.printf "(P%d) ==[ (P%d) ]==>\n\t%s\n" 73 | ps pd (string_of_signal signal) 74 | | AArrive (ps, pd, signal) -> 75 | Printf.printf "(P%d) <==[ (P%d) ]==\n\t%s\n" 76 | pd ps (string_of_signal signal) 77 | | ASpawn (p, _, _, _) -> 78 | Printf.printf "(P%d) --{spawned}--> (P%d)\n" pid p 79 | 80 | (* Eval K steps *) 81 | let rec eval_k_steps k = 82 | if k = 0 then finish_off_if_dead () 83 | else 84 | match currPID state.conf with 85 | | None -> () 86 | | Some pid -> 87 | if isDead state.p_node pid then 88 | finish_off_if_dead () 89 | else 90 | match interProcessStepFuncFast state.p_node state.hipid (Inl pid) with 91 | | None -> () 92 | | Some ((node', action), hipid') -> 93 | display_action pid action; 94 | state.p_node <- node'; 95 | state.conf <- newConfByAction state.conf action; 96 | state.hipid <- hipid'; 97 | match action_to_msg_pids action with 98 | | Some msg -> 99 | state.msgs <- msg :: state.msgs; 100 | eval_k_steps (k - 1) 101 | | None -> 102 | eval_k_steps (k - 1) 103 | 104 | (* Finish off if dead *) 105 | and finish_off_if_dead () = 106 | match currPID state.conf with 107 | | None -> () 108 | | Some pid -> 109 | if isDead state.p_node pid then 110 | if isTotallyDead state.p_node pid then 111 | state.conf <- delCurrFromConf state.conf 112 | else 113 | (match interProcessStepFuncFast state.p_node state.hipid (Inl pid) with 114 | | None -> () 115 | | Some ((node', action), hipid') -> 116 | display_action pid action; 117 | state.p_node <- node'; 118 | state.hipid <- hipid'; 119 | finish_off_if_dead ()) 120 | else () 121 | 122 | (* Deliver a single signal *) 123 | let deliver_signal (src, dst) = 124 | match interProcessStepFuncFast state.p_node state.hipid (Inr (src, dst)) with 125 | | None -> () 126 | | Some ((node', action), hipid') -> 127 | display_action dst action; 128 | state.p_node <- node'; 129 | state.hipid <- hipid' 130 | 131 | (* Deliver all signals *) 132 | let rec deliver_all_signals () = 133 | match state.msgs with 134 | | [] -> () 135 | | x :: xs -> 136 | deliver_signal x; 137 | state.msgs <- xs; 138 | deliver_all_signals () 139 | 140 | (* Empty ether *) 141 | let empty_ether () = 142 | (*let signals = etherNonEmpty state.p_node in*) 143 | deliver_all_signals () 144 | 145 | (* Eval program main loop *) 146 | let rec eval_program k = 147 | match currPID state.conf with 148 | | None -> () 149 | | Some _ -> 150 | eval_k_steps k; 151 | empty_ether (); 152 | state.conf <- nextConf state.conf; 153 | eval_program k 154 | 155 | (* Entry point *) 156 | let () = 157 | (* Initialize state *) 158 | state.p_node <- fst (fst (fst example_for_exec)); 159 | state.conf <- snd (fst (fst example_for_exec)); 160 | state.hipid <- snd (fst example_for_exec); 161 | state.msgs <- snd example_for_exec; 162 | 163 | eval_program 10_000; 164 | 165 | (* Print final state, or whatever you want *) 166 | print_endline "Program finished" 167 | 168 | -------------------------------------------------------------------------------- /Erl_codes/equiv.core: -------------------------------------------------------------------------------- 1 | module 'equiv' ['clause1'/3, 2 | 'clause2'/3, 3 | 'exp1'/0, 4 | 'exp2'/0, 5 | 'module_info'/0, 6 | 'module_info'/1] 7 | attributes [%% Line 1 8 | 'file' = 9 | %% Line 1 10 | [{[101|[113|[117|[105|[118|[46|[101|[114|[108]]]]]]]]],1}], 11 | %% Line 2 12 | 'compile' = 13 | %% Line 2 14 | ['export_all']] 15 | 'exp1'/0 = 16 | %% Line 4 17 | ( fun () -> 18 | ( case ( <> 19 | -| [{'function',{'exp1',0}}] ) of 20 | <> when 'true' -> 21 | let = 22 | call %% Line 5 23 | 'erlang':%% Line 5 24 | '+' 25 | (%% Line 5 26 | 1, %% Line 5 27 | 2) 28 | in let = 29 | call %% Line 6 30 | 'erlang':%% Line 6 31 | '+' 32 | (%% Line 6 33 | 1, %% Line 6 34 | 2) 35 | in let = 36 | call %% Line 7 37 | 'erlang':%% Line 7 38 | '+' 39 | (%% Line 7 40 | 1, %% Line 7 41 | 2) 42 | in %% Line 8 43 | case call 'erlang':'+' 44 | (5, 5) of 45 | %% Line 9 46 | <'true'> when 'true' -> 47 | E2 48 | %% Line 10 49 | <_4> when 'true' -> 50 | E3 51 | ( <_3> when 'true' -> 52 | primop 'match_fail' 53 | ({'case_clause',_3}) 54 | -| ['compiler_generated'] ) 55 | end 56 | ( <> when 'true' -> 57 | ( primop 'match_fail' 58 | (( {'function_clause'} 59 | -| [{'function',{'exp1',0}}] )) 60 | -| [{'function',{'exp1',0}}] ) 61 | -| ['compiler_generated'] ) 62 | end 63 | -| [{'function',{'exp1',0}}] ) 64 | -| [{'function',{'exp1',0}}] ) 65 | 'exp2'/0 = 66 | %% Line 13 67 | ( fun () -> 68 | ( case ( <> 69 | -| [{'function',{'exp2',0}}] ) of 70 | <> when 'true' -> 71 | let = 72 | call %% Line 14 73 | 'erlang':%% Line 14 74 | '+' 75 | (%% Line 14 76 | 1, %% Line 14 77 | 2) 78 | in let = 79 | call %% Line 15 80 | 'erlang':%% Line 15 81 | '+' 82 | (%% Line 15 83 | 1, %% Line 15 84 | 2) 85 | in let = 86 | call %% Line 16 87 | 'erlang':%% Line 16 88 | '+' 89 | (%% Line 16 90 | 1, %% Line 16 91 | 2) 92 | in %% Line 17 93 | case <> of 94 | <> 95 | when try 96 | let <_3> = 97 | call 'erlang':'+' 98 | (5, 5) 99 | in ( call 'erlang':'=:=' 100 | (_3, 'true') 101 | -| ['compiler_generated'] ) 102 | of -> 103 | Try 104 | catch -> 105 | 'false' -> 106 | E2 107 | %% Line 18 108 | <> when 'true' -> 109 | E3 110 | ( <> when 'true' -> 111 | primop 'match_fail' 112 | ('if_clause') 113 | -| ['compiler_generated'] ) 114 | end 115 | ( <> when 'true' -> 116 | ( primop 'match_fail' 117 | (( {'function_clause'} 118 | -| [{'function',{'exp2',0}}] )) 119 | -| [{'function',{'exp2',0}}] ) 120 | -| ['compiler_generated'] ) 121 | end 122 | -| [{'function',{'exp2',0}}] ) 123 | -| [{'function',{'exp2',0}}] ) 124 | 'clause1'/3 = 125 | %% Line 21 126 | ( fun (_0,_1,_2) -> 127 | ( case ( <_0,_1,_2> 128 | -| [{'function',{'clause1',3}}] ) of 129 | 130 | when try 131 | let <_3> = 132 | call 'erlang':'length' 133 | (X) 134 | in call 'erlang':'==' 135 | (_3, 0) 136 | of -> 137 | Try 138 | catch -> 139 | 'false' -> 140 | E1 141 | %% Line 22 142 | when 'true' -> 143 | E2 144 | ( <_6,_5,_4> when 'true' -> 145 | ( primop 'match_fail' 146 | (( {'function_clause',_6,_5,_4} 147 | -| [{'function',{'clause1',3}}] )) 148 | -| [{'function',{'clause1',3}}] ) 149 | -| ['compiler_generated'] ) 150 | end 151 | -| [{'function',{'clause1',3}}] ) 152 | -| [{'function',{'clause1',3}}] ) 153 | 'clause2'/3 = 154 | %% Line 24 155 | ( fun (_0,_1,_2) -> 156 | ( case ( <_0,_1,_2> 157 | -| [{'function',{'clause2',3}}] ) of 158 | <[],E1,E2> when 'true' -> 159 | E1 160 | %% Line 25 161 | when 'true' -> 162 | E2 163 | ( <_5,_4,_3> when 'true' -> 164 | ( primop 'match_fail' 165 | (( {'function_clause',_5,_4,_3} 166 | -| [{'function',{'clause2',3}}] )) 167 | -| [{'function',{'clause2',3}}] ) 168 | -| ['compiler_generated'] ) 169 | end 170 | -| [{'function',{'clause2',3}}] ) 171 | -| [{'function',{'clause2',3}}] ) 172 | 'module_info'/0 = 173 | ( fun () -> 174 | ( case ( <> 175 | -| [{'function',{'module_info',0}}] ) of 176 | <> when 'true' -> 177 | call 'erlang':'get_module_info' 178 | ('equiv') 179 | ( <> when 'true' -> 180 | ( primop 'match_fail' 181 | (( {'function_clause'} 182 | -| [{'function',{'module_info',0}}] )) 183 | -| [{'function',{'module_info',0}}] ) 184 | -| ['compiler_generated'] ) 185 | end 186 | -| [{'function',{'module_info',0}}] ) 187 | -| [{'function',{'module_info',0}}] ) 188 | 'module_info'/1 = 189 | ( fun (_0) -> 190 | ( case ( _0 191 | -| [{'function',{'module_info',1}}] ) of 192 | when 'true' -> 193 | call 'erlang':'get_module_info' 194 | ('equiv', X) 195 | ( <_1> when 'true' -> 196 | ( primop 'match_fail' 197 | (( {'function_clause',_1} 198 | -| [{'function',{'module_info',1}}] )) 199 | -| [{'function',{'module_info',1}}] ) 200 | -| ['compiler_generated'] ) 201 | end 202 | -| [{'function',{'module_info',1}}] ) 203 | -| [{'function',{'module_info',1}}] ) 204 | end -------------------------------------------------------------------------------- /src/Assignments.v: -------------------------------------------------------------------------------- 1 | (** 2 | This file contains assignments about the semantics of Core Erlang, which can 3 | help the readers get familiar with it. 4 | *) 5 | (* From CoreErlang.BigStep Require Import FunctionalBigStep. *) 6 | From CoreErlang.FrameStack Require SubstSemantics 7 | CIU. 8 | 9 | Open Scope string_scope. 10 | 11 | Module FrameStack. 12 | 13 | Import FrameStack.SubstSemantics FrameStack.CIU. 14 | Import ListNotations. 15 | (* 16 | Let "e" be a parameter expression. 17 | 18 | letrec 'fact'/1 = 19 | fun(X) -> 20 | case of 21 | <0> when 'true' -> 1 22 | when 'true'-> 23 | let = 24 | in call 'erlang':'*'(Z,Y) 25 | in 26 | apply 'fact'/1(e) 27 | 28 | Define the above expression! 29 | *) 30 | 31 | Definition fact (e : Exp) : Exp := 32 | ˝ttrue (* Write the definition here *) 33 | . 34 | 35 | (* Prove the following property *) 36 | (* Hint: to solve statements about scopes (e.g., VALCLOSED), use "scope_solver"! 37 | Also using "(e)constructor" could help you determine which rule of the semantics 38 | can be used. Beware, not all semantic rules are syntax-driven, there are rules 39 | about ECase expressions that can applied to the same configuration. 40 | 41 | Since you prove the evaluation of a factorial function, thus expect repetition 42 | of proof steps in the script you write. This proof should not be short (>120 LOC), 43 | if you write out each step. 44 | 45 | Tactics that can aid in this proof: apply, (e)constructor, simpl, cbn, cbv, 46 | relfexivity, auto, congruence, lia, scope_solver 47 | *) 48 | Goal 49 | ⟨[], fact (˝VLit 3%Z)⟩ -->* RValSeq [VLit 6%Z]. 50 | Proof. 51 | 52 | Admitted. 53 | 54 | (* Define the following function in Core Erlang! To compile a Core Erlang file 55 | use the "from_core" option of the standard compiler/interpreter. 56 | For examples, we refer to the language specification: 57 | https://www.diva-portal.org/smash/record.jsf?dswid=-4140&pid=diva2%3A1695554 58 | You can also check example codes in the Erl_codes folder. 59 | Instead of the letrec expression, define it as a top level function *) 60 | Definition collatz (e : Exp) : Exp := 61 | ELetRec [ 62 | (1, °ECase (˝VVar 1) 63 | [ 64 | ([PLit 1%Z], ˝ttrue, ˝VNil); 65 | ([PVar], 66 | °ECall (˝erlang) (˝VLit "and") [ 67 | °ECall (˝erlang) (˝VLit "<") [˝VLit 0%Z; ˝VVar 0]; 68 | °ECall (˝erlang) (˝VLit "==") [ 69 | ˝VLit 0%Z; 70 | °ECall (˝erlang) (˝VLit "rem") [˝VVar 0; ˝VLit 2%Z] 71 | ] 72 | ], 73 | °ECons (˝VVar 0) (EApp (˝VFunId (1,1)) [ 74 | °ECall (˝erlang) (˝VLit "div") [˝VVar 0; ˝VLit 2%Z] 75 | ]) 76 | ); 77 | ([PVar], °ECall (˝erlang) (˝VLit "<") [˝VLit 0%Z; ˝VVar 0], 78 | °ECons (˝VVar 0) (EApp (˝VFunId (1,1)) [ 79 | °ECall (˝erlang) (˝VLit "+") 80 | [°ECall (˝erlang) (˝VLit "*") [˝VLit 3%Z; ˝VVar 0]; 81 | ˝VLit 1%Z] 82 | ]) 83 | ) 84 | ]) 85 | ] 86 | (EApp (˝VFunId (0, 1)) [e]). 87 | 88 | 89 | (* 90 | Hard task: 91 | Prove the following theorem about the correctness of fact! 92 | 93 | Use induction over n! Follow the scheme described in the previous evaluation. 94 | Check what theorems are available about transitive evaluation. 95 | *) 96 | Theorem fact_eval : forall n, 97 | ⟨[], fact (˝VLit (Z.of_nat n))⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n))]. 98 | Proof. 99 | 100 | Admitted. 101 | 102 | 103 | 104 | (* 105 | Let "e" and "d" be parameter expressions. 106 | 107 | letrec 'fact'/2 = 108 | fun(X, A) -> 109 | case of 110 | <0> when 'true' -> A 111 | when 'true' -> apply 'fact'/2(call 'erlang':'-'(Z, 1), call 'erlang':'*'(Z, A)) 112 | in 113 | apply 'fact'/2(e, d) 114 | 115 | Define the above expression! 116 | *) 117 | Definition tailrec_fact (e d : Exp) : Exp := 118 | ˝ttrue (* Write the definition here *) 119 | . 120 | 121 | (* Prove the following property *) 122 | (* Hint: to solve statements about scopes (e.g., VALCLOSED), use "scope_solver"! 123 | Also using "(e)constructor" could help you determine which rule of the semantics 124 | can be used. Beware, not all semantic rules are syntax-driven, there are rules 125 | about ECase expressions that can applied to the same configuration. 126 | 127 | Since you prove the evaluation of a factorial function, thus expect repetition 128 | of proof steps in the script you write. This proof should not be short, 129 | if you write out each step. 130 | 131 | Tactics that can aid in this proof: apply, (e)constructor, simpl, cbn, cbv, 132 | relfexivity, auto, congruence, lia, scope_solver 133 | *) 134 | Goal 135 | ⟨[], tailrec_fact (˝VLit 3%Z) (˝VLit 1%Z)⟩ -->* RValSeq [VLit 6%Z]. 136 | Proof. 137 | 138 | Admitted. 139 | 140 | (* 141 | Hard task: 142 | Prove the following theorem about the correctness of 143 | tailrec_fact! 144 | 145 | Use induction over "n"! Follow the scheme described in the previous 146 | evaluation. Check what theorems are available about transitive evaluation. 147 | 148 | Remember that this is the tail recursive version of factorial; therefore, 149 | you should NOT introduce "m" before starting induction (since "m"---the second 150 | parameter---increases in the recursive applications. 151 | ). 152 | *) 153 | Theorem tailrec_fact_eval : forall n m, 154 | ⟨[], tailrec_fact (˝VLit (Z.of_nat n)) (˝VLit (Z.of_nat m))⟩ -->* RValSeq [VLit (Z.of_nat (Factorial.fact n * m))]. 155 | Proof. 156 | 157 | Admitted. 158 | 159 | 160 | (* Prove the following program equivalence theorem. *) 161 | (* Hint: search the repository for theorems about evaluation and CIU equivalence! 162 | Rather than using manual evaluation steps, try to rely on the previous theorems! 163 | *) 164 | Theorem fact_equiv n : 165 | CIU (fact (˝VLit (Z.of_nat n))) (tailrec_fact (˝VLit (Z.of_nat n)) (˝VLit 1%Z)). 166 | Proof. 167 | 168 | Admitted. 169 | 170 | 171 | End FrameStack. 172 | 173 | Module Concurrent. 174 | 175 | Import FrameStack.SubstSemantics. 176 | Import ListNotations. 177 | 178 | 179 | 180 | End Concurrent. 181 | -------------------------------------------------------------------------------- /src/BigStep/Environment.v: -------------------------------------------------------------------------------- 1 | (** 2 | This file defines variable environment for the big-step semantics of Core Erlang. 3 | *) 4 | From CoreErlang.BigStep Require Export Helpers. 5 | 6 | (** Environment and its functions *) 7 | Import ListNotations. 8 | 9 | Definition Environment : Type := list ((Var + FunctionIdentifier) * Value). 10 | 11 | Fixpoint count_closures (env : Environment) : nat := 12 | match env with 13 | | [] => 0 14 | | (_, VClos _ _ _ _ _)::xs => S (count_closures xs) 15 | | _::xs => count_closures xs 16 | end. 17 | 18 | (** Get *) 19 | Fixpoint get_value (env : Environment) (key : (Var + FunctionIdentifier)) 20 | : option ValueSequence := 21 | match env with 22 | | [ ] => None 23 | | (k,v)::xs => if var_funid_eqb key k then Some [v] else get_value xs key 24 | end. 25 | 26 | (** Insert *) 27 | Fixpoint insert_value (env : Environment) (key : (Var + FunctionIdentifier)) 28 | (value : Value) : Environment := 29 | match env with 30 | | [] => [(key, value)] 31 | | (k,v)::xs => if var_funid_eqb k key then (key,value)::xs else (k,v)::(insert_value xs key value) 32 | end. 33 | 34 | (** Add additional bindings *) 35 | (** We used here: when binding, variables must be unique *) 36 | Fixpoint add_bindings (bindings : list (Var * Value)) (env : Environment) : Environment := 37 | match bindings with 38 | | [] => env 39 | | (v, e)::xs => add_bindings xs (insert_value env (inl v) e) 40 | end. 41 | 42 | (** Add bindings with two lists *) 43 | Fixpoint append_vars_to_env (vl : list Var) (el : list Value) (d : Environment) 44 | : Environment := 45 | match vl, el with 46 | | [], [] => d 47 | | v::vs, e::es => append_vars_to_env vs es (insert_value d (inl v) e) 48 | | _, _ => [] 49 | end. 50 | 51 | 52 | Definition append_try_vars_to_env (vl : list Var) (el : list Value) (d : Environment) 53 | : Environment := 54 | match el with 55 | | [] => [] 56 | | e::es => 57 | if length vl =? 2 then append_vars_to_env vl es d else append_vars_to_env vl el d 58 | end. 59 | 60 | Goal append_try_vars_to_env ["X"%string; "Y"%string] [VNil; VNil; VNil] [] 61 | = [(inl "X"%string, VNil); (inl "Y"%string, VNil)]. 62 | Proof. reflexivity. Qed. 63 | 64 | (** Not Overwriting insert *) 65 | (** Overwriting does not fit with this recursion *) 66 | Fixpoint insert_function (id : nat) (v : FunctionIdentifier) (p : list Var) (b : Expression) 67 | (l : list (nat * FunctionIdentifier * FunctionExpression)) 68 | : list (nat * FunctionIdentifier * FunctionExpression) := 69 | match l with 70 | | [] => [(id, v, (p, b))] 71 | | (id', k, v0)::xs => if funid_eqb k v then (id', k, v0)::xs 72 | else (id', k, v0)::(insert_function id v p b xs) 73 | end. 74 | 75 | (** Lists represented functions *) 76 | Fixpoint list_functions (vl : list FunctionIdentifier) (paramss : list (list Var)) 77 | (bodies : list Expression) (last_id : nat) 78 | : list (nat * FunctionIdentifier * FunctionExpression) := 79 | match vl, paramss, bodies with 80 | | [], [], [] => [] 81 | | v::vs, varl::ps, e::bs => insert_function last_id v varl e 82 | (list_functions vs ps bs (S last_id)) 83 | | _, _, _ => [] 84 | end. 85 | 86 | (** Add functions *) 87 | Fixpoint append_funs_to_env_base (vl : list FunctionIdentifier) (paramss : list (list Var)) 88 | (bodies : list Expression) (d : Environment) (def : Environment) 89 | (deffuns : list (nat * FunctionIdentifier * FunctionExpression)) (last_id : nat) 90 | : Environment := 91 | match vl, paramss, bodies with 92 | | [], [], [] => d 93 | | v::vs, varl::ps, e::bs => append_funs_to_env_base vs ps bs 94 | (insert_value d (inr v) 95 | (VClos def deffuns last_id varl e)) 96 | def deffuns (S last_id) 97 | | _, _, _ => [] 98 | end. 99 | 100 | Definition append_funs_to_env (l : list (FunctionIdentifier * ((list Var) * Expression))) (d : Environment) (last_id : nat) : Environment := 101 | append_funs_to_env_base (fst (split l)) (fst (split (snd (split l)))) (snd (split (snd (split l)))) d d 102 | (list_functions (fst (split l)) (fst (split (snd (split l)))) (snd (split (snd (split l)))) last_id) 103 | last_id 104 | . 105 | 106 | (** Examples *) 107 | Goal append_vars_to_env ["A"%string; "A"%string] 108 | [(VEmptyMap); (VEmptyTuple)] 109 | [(inl "A"%string, VEmptyMap)] 110 | = [(inl "A"%string, VTuple [])]. 111 | Proof. reflexivity. Qed. 112 | Goal append_funs_to_env [(("f1"%string,0), ([], ErrorExp)) ; 113 | (("f2"%string,0), ([], ErrorExp)) ; 114 | (("f1"%string,0), ([], ErrorExp)) ] 115 | [(inl "X"%string, ErrorValue)] 0 116 | = 117 | [(inl "X"%string, VLit (Atom "error")); 118 | (inr ("f1"%string, 0), 119 | VClos [(inl "X"%string, VLit (Atom "error"))] 120 | [(2, ("f1"%string, 0), ([], ELit (Atom "error"))); 121 | (1, ("f2"%string, 0), ([], ELit (Atom "error")))] 2 [] (ELit (Atom "error"))); 122 | (inr ("f2"%string, 0), 123 | VClos [(inl "X"%string, VLit (Atom "error"))] 124 | [(2, ("f1"%string, 0), ([], ELit (Atom "error"))); 125 | (1, ("f2"%string, 0), ([], ELit (Atom "error")))] 1 [] (ELit (Atom "error")))]. 126 | Proof. reflexivity. Qed. 127 | Goal insert_function 2 ("f1"%string, 0) [] ErrorExp (list_functions 128 | [("f1"%string,0); ("f2"%string,0); ("f1"%string, 0)] 129 | [[];[];[]] 130 | [ErrorExp; ErrorExp; ErrorExp] 0) 131 | = [(2, ("f1"%string, 0), ([], ELit (Atom "error"))); 132 | (1, ("f2"%string, 0), ([], ELit (Atom "error")))]. 133 | Proof. reflexivity. Qed. 134 | 135 | (** Environment construction from the extension and the reference *) 136 | Fixpoint get_env_base (env def : Environment) 137 | (ext defext : list (nat * FunctionIdentifier * FunctionExpression)) 138 | : Environment := 139 | match ext with 140 | | [] => env 141 | | (id, f1, (pl, b))::xs => get_env_base (insert_value env (inr f1) (VClos def defext id pl b)) def xs defext 142 | end. 143 | 144 | Definition get_env (env : Environment) 145 | (ext : list (nat * FunctionIdentifier * FunctionExpression)) 146 | : Environment := 147 | get_env_base env env ext ext 148 | . 149 | -------------------------------------------------------------------------------- /Erl_codes/weird2.core: -------------------------------------------------------------------------------- 1 | module 'weird2' ['f'/0, 2 | 'module_info'/0, 3 | 'module_info'/1] 4 | attributes ['file' = 5 | [{[119|[101|[105|[114|[100|[46|[101|[114|[108]]]]]]]]],1}], 6 | 'compile' = 7 | ['export_all']] 8 | 'f'/0 = 9 | fun () -> 10 | do call 'erlang':'spawn' 11 | (fun () -> 12 | call 'io':'fwrite' 13 | ([111])) 14 | let <_X_X_0> = 15 | call 'erlang':'self' 16 | () 17 | in do call 'erlang':'!' 18 | (_X_X_0, 1) 19 | let <_X_X_1> = 20 | call 'erlang':'self' 21 | () 22 | in do call 'erlang':'!' 23 | (_X_X_1, 2) 24 | let <_X_X_2> = 25 | call 'erlang':'self' 26 | () 27 | in do call 'erlang':'!' 28 | (_X_X_2, 3) 29 | try 30 | ( letrec 31 | '@pre1'/0 = 32 | fun () -> 33 | let <_X_4,_X_2> = 34 | primop 'recv_peek_message' 35 | () 36 | in case _X_4 of 37 | <'true'> when 'true' -> 38 | case _X_2 of 39 | <3> 40 | when call 'erlang':'/' 41 | (1, 42 | 0) -> 43 | do primop 'remove_message' 44 | () 45 | 'Something_wrong' 46 | ( when 'true' -> 47 | do primop 'recv_next' 48 | () 49 | apply '@pre1'/0 50 | () 51 | -| ['compiler_generated'] ) 52 | end 53 | <'false'> when 'true' -> 54 | let <_X_3> = 55 | primop 'recv_wait_timeout' 56 | ('infinity') 57 | in case _X_3 of 58 | <'true'> when 'true' -> 59 | 0 60 | <'false'> when 'true' -> 61 | apply '@pre1'/0 62 | () 63 | end 64 | end 65 | in apply '@pre1'/0 66 | () 67 | -| ['letrec_goto'] ) 68 | of -> 69 | X 70 | catch -> 71 | do ( letrec 72 | '@pre1'/0 = 73 | fun () -> 74 | let <_2> = 75 | primop 'recv_wait_timeout' 76 | (10) 77 | in case _2 of 78 | <'true'> when 'true' -> 79 | 'ok' 80 | <'false'> when 'true' -> 81 | apply '@pre1'/0 82 | () 83 | end 84 | in apply '@pre1'/0 85 | () 86 | -| ['letrec_goto'] ) 87 | {X_c,Y,Z,{( letrec 88 | '@pre6'/0 = 89 | fun () -> 90 | let <_X_9,_X_7> = 91 | primop 'recv_peek_message' 92 | () 93 | in case _X_9 of 94 | <'true'> when 'true' -> 95 | do primop 'remove_message' 96 | () 97 | _X_7 98 | <'false'> when 'true' -> 99 | let <_X_8> = 100 | primop 'recv_wait_timeout' 101 | (0) 102 | in case _X_8 of 103 | <'true'> when 'true' -> 104 | 'noval' 105 | <'false'> when 'true' -> 106 | apply '@pre6'/0 107 | () 108 | end 109 | end 110 | in apply '@pre6'/0 111 | () 112 | -| ['letrec_goto'] ),( letrec 113 | '@pre11'/0 = 114 | fun () -> 115 | let <_X_14,_X_12> = 116 | primop 'recv_peek_message' 117 | () 118 | in case _X_14 of 119 | <'true'> when 'true' -> 120 | do primop 'remove_message' 121 | () 122 | _X_12 123 | <'false'> when 'true' -> 124 | let <_X_13> = 125 | primop 'recv_wait_timeout' 126 | (0) 127 | in case _X_13 of 128 | <'true'> when 'true' -> 129 | 'noval' 130 | <'false'> when 'true' -> 131 | apply '@pre11'/0 132 | () 133 | end 134 | end 135 | in apply '@pre11'/0 136 | () 137 | -| ['letrec_goto'] ),( letrec 138 | '@pre16'/0 = 139 | fun () -> 140 | let <_X_19,_X_17> = 141 | primop 'recv_peek_message' 142 | () 143 | in case _X_19 of 144 | <'true'> when 'true' -> 145 | do primop 'remove_message' 146 | () 147 | _X_17 148 | <'false'> when 'true' -> 149 | let <_X_18> = 150 | primop 'recv_wait_timeout' 151 | (0) 152 | in case _X_18 of 153 | <'true'> when 'true' -> 154 | 'noval' 155 | <'false'> when 'true' -> 156 | apply '@pre16'/0 157 | () 158 | end 159 | end 160 | in apply '@pre16'/0 161 | () 162 | -| ['letrec_goto'] ),try ( letrec 163 | '@pre21'/0 = 164 | fun () -> 165 | let <_X_24,_X_22> = 166 | primop 'recv_peek_message' 167 | () 168 | in case _X_24 of 169 | <'true'> when 'true' -> 170 | do primop 'remove_message' 171 | () 172 | _X_22 173 | <'false'> when 'true' -> 174 | let <_X_23> = 175 | primop 'recv_wait_timeout' 176 | ('asd') 177 | in case _X_23 of 178 | <'true'> when 'true' -> 179 | 'noval' 180 | <'false'> when 'true' -> 181 | apply '@pre21'/0 182 | () 183 | end 184 | end 185 | in apply '@pre21'/0 186 | () 187 | -| ['letrec_goto'] ) 188 | of -> 'noval' 189 | catch -> {X, Y, Z}}} 190 | 'module_info'/0 = 191 | ( fun () -> 192 | call 'erlang':'get_module_info' 193 | ('weird') 194 | -| [{'function',{'module_info',0}}] ) 195 | 'module_info'/1 = 196 | ( fun (_X_X_0) -> 197 | call 'erlang':'get_module_info' 198 | ('weird', ( _X_X_0 199 | -| [{'function',{'module_info',1}}] )) 200 | -| [{'function',{'module_info',1}}] ) 201 | end 202 | -------------------------------------------------------------------------------- /src/BigStep/EraseNames.v: -------------------------------------------------------------------------------- 1 | (** 2 | This file contains the transformation of the big-step syntax into the frame 3 | stack approach. 4 | *) 5 | 6 | From CoreErlang.BigStep Require Import BigStep. 7 | From CoreErlang.FrameStack Require Import SubstSemantics. 8 | Import ListNotations. 9 | 10 | Definition LiteralToLit (l : Literal) : Lit := 11 | match l with 12 | | BigStep.Syntax.Atom s => s 13 | | BigStep.Syntax.Integer x => x 14 | end. 15 | 16 | Fixpoint eraseNamesPat (p : Pattern) : Pat := 17 | match p with 18 | | BigStep.Syntax.PVar v => PVar 19 | | BigStep.Syntax.PLit l => PLit (LiteralToLit l) 20 | | BigStep.Syntax.PCons hd tl => PCons (eraseNamesPat hd) (eraseNamesPat tl) 21 | | BigStep.Syntax.PTuple l => PTuple (map eraseNamesPat l) 22 | | BigStep.Syntax.PMap l => PMap (map (fun '(x, y) => (eraseNamesPat x, eraseNamesPat y)) l) 23 | | BigStep.Syntax.PNil => PNil 24 | end. 25 | 26 | 27 | Definition NameSub {T} {dec : T -> T -> bool} := T -> nat. 28 | 29 | Definition addName {T dec} (v : T) (σ : @NameSub _ dec) := 30 | fun x => if dec x v 31 | then 0 32 | else S (σ x). 33 | 34 | Definition addNames {T} {dec : T -> T -> bool} (vl : list T) (σ : NameSub) : NameSub := 35 | fold_right (@addName _ dec) σ vl. 36 | 37 | Definition varsOfPatternList (l : list Pattern) : list BigStep.Syntax.Var := 38 | fold_right (fun x acc => variable_occurances x ++ acc) nil l 39 | . 40 | 41 | Definition sum_eqb {A B : Type} (eqbA : A -> A -> bool) (eqbB : B -> B -> bool) (a b : A + B) : bool := 42 | match a, b with 43 | | inl a', inl b' => eqbA a' b' 44 | | inr a', inr b' => eqbB a' b' 45 | | _, _ => false 46 | end. 47 | 48 | Definition addVars (vl : list string) (σ : @NameSub (string + FunctionIdentifier) (sum_eqb String.eqb (prod_eqb String.eqb Nat.eqb))) : @NameSub (string + FunctionIdentifier) (sum_eqb String.eqb (prod_eqb String.eqb Nat.eqb)) := 49 | addNames (map inl vl) σ. 50 | 51 | Definition addFids (vl : list FunctionIdentifier) (σ : @NameSub (string + FunctionIdentifier) (sum_eqb String.eqb (prod_eqb String.eqb Nat.eqb))) : @NameSub (string + FunctionIdentifier) (sum_eqb String.eqb (prod_eqb String.eqb Nat.eqb)) := 52 | addNames (map inr vl) σ. 53 | 54 | Fixpoint eraseNames (σᵥ : @NameSub (string + FunctionIdentifier) (sum_eqb String.eqb (prod_eqb String.eqb Nat.eqb))) (* (: @NameSub (string * nat) (prod_eqb eqb Nat.eqb)) *) 55 | (e : Expression) : Exp := 56 | match e with 57 | | BigStep.Syntax.EValues el => EValues (map (eraseNames σᵥ) el) 58 | | ENil => ˝VNil 59 | | ELit l => ˝VLit (LiteralToLit l) 60 | | EVar v => ˝VVar (σᵥ (inl v)) 61 | | EFunId f => ˝VFunId ((σᵥ (inr f)), snd f) 62 | | BigStep.Syntax.EFun vl e => EFun (length vl) (eraseNames (addVars vl σᵥ) e) 63 | | BigStep.Syntax.ECons hd tl => ECons (eraseNames σᵥ hd) (eraseNames σᵥ tl) 64 | | BigStep.Syntax.ETuple l => ETuple (map (eraseNames σᵥ) l) 65 | | BigStep.Syntax.ECall m f l => ECall (eraseNames σᵥ m) (eraseNames σᵥ f) (map (eraseNames σᵥ) l) 66 | | BigStep.Syntax.EPrimOp f l => EPrimOp f (map (eraseNames σᵥ) l) 67 | | BigStep.Syntax.EApp exp l => EApp (eraseNames σᵥ exp) (map (eraseNames σᵥ) l) 68 | | BigStep.Syntax.ECase e l => ECase (eraseNames σᵥ e) (map (fun '(pl, g, b) => 69 | ((map eraseNamesPat pl), eraseNames (addVars (varsOfPatternList pl) σᵥ) g, eraseNames (addVars (varsOfPatternList pl) σᵥ) b)) 70 | l) 71 | | BigStep.Syntax.ELet l e1 e2 => ELet (length l) (eraseNames σᵥ e1) (eraseNames (addVars l σᵥ) e2) 72 | | BigStep.Syntax.ESeq e1 e2 => ESeq (eraseNames σᵥ e1) (eraseNames σᵥ e2) 73 | | BigStep.Syntax.ELetRec l e => ELetRec (map (fun '(fid, (vl, b)) => 74 | (length vl, eraseNames (addNames (map (inr ∘ fst) l ++ map inl vl) σᵥ) b) 75 | ) l) 76 | (eraseNames (addFids (map fst l) σᵥ) e) 77 | | BigStep.Syntax.EMap l => EMap (map (fun '(x, y) => (eraseNames σᵥ x, eraseNames σᵥ y)) l) 78 | | BigStep.Syntax.ETry e1 vl1 e2 vl2 e0 => ETry (eraseNames σᵥ e1) 79 | (length vl1) (eraseNames (addVars vl1 σᵥ) e2) 80 | (length vl2) (eraseNames (addVars vl1 σᵥ) e0) 81 | end. 82 | 83 | Inductive well_formed_Expression : Expression -> Prop := (*TODO*). 84 | 85 | Open Scope string_scope. 86 | 87 | Goal eraseNames (fun _ => 0) (BigStep.Syntax.ELet ["X"; "Y"] (BigStep.Syntax.EValues [ELit (BigStep.Syntax.Integer 0); ELit (BigStep.Syntax.Integer 1)]) (BigStep.Syntax.ETuple [EVar "X"; EVar "Y"])) = 88 | ELet 2 (EValues [˝VLit 0%Z; ˝VLit 1%Z]) (ETuple [˝VVar 0; ˝VVar 1]). 89 | Proof. 90 | cbn. reflexivity. 91 | Qed. 92 | 93 | Import BigStep. 94 | 95 | Definition cica := ELetRec [(("f"%string, 2),(["_0"%string;"_1"%string], ((ECase (EValues [(EVar "_0"%string);(EVar "_1"%string)]) [([(PVar "X"%string);(PVar "N"%string)], ((ELit (Atom "true"%string))), ((ELet ["_2"%string] ((ECall ((ELit (Atom "erlang"%string))) ((ELit (Atom "integer_to_list"%string))) [((EVar "N"%string))])) ((ELet ["_3"%string] ((ECall ((ELit (Atom "erlang"%string))) ((ELit (Atom "++"%string))) [((EVar "X"%string));((EVar "_2"%string))])) ((ESeq ((ECall ((ELit (Atom "erlang"%string))) ((ELit (Atom "list_to_atom"%string))) [((EVar "_3"%string))])) ((ELet ["_4"%string] ((ECall ((ELit (Atom "erlang"%string))) ((ELit (Atom "+"%string))) [((EVar "N"%string));((ELit (Integer (1))))])) ((EApp ((EFunId ("f"%string, 2))) [((EVar "X"%string));((EVar "_4"%string))])))))))))));([(PVar "_6"%string);(PVar "_5"%string)], ((ELit (Atom "true"%string))), ((EPrimOp "match_fail"%string [((ETuple [((ELit (Atom "function_clause"%string)));((EVar "_6"%string));((EVar "_5"%string))]))])))]))));(("module_info"%string, 0),([], ((ECase (EValues []) [([], ((ELit (Atom "true"%string))), ((ECall ((ELit (Atom "erlang"%string))) ((ELit (Atom "get_module_info"%string))) [((ELit (Atom "exhaustion"%string)))])));([], ((ELit (Atom "true"%string))), ((EPrimOp "match_fail"%string [((ETuple [((ELit (Atom "function_clause"%string)))]))])))]))));(("module_info"%string, 1),(["_0"%string], ((ECase ((EVar "_0"%string)) [([(PVar "X"%string)], ((ELit (Atom "true"%string))), ((ECall ((ELit (Atom "erlang"%string))) ((ELit (Atom "get_module_info"%string))) [((ELit (Atom "exhaustion"%string)));((EVar "X"%string))])));([(PVar "_1"%string)], ((ELit (Atom "true"%string))), ((EPrimOp "match_fail"%string [((ETuple [((ELit (Atom "function_clause"%string)));((EVar "_1"%string))]))])))]))))] (EApp (EFunId ("main"%string,0)) []). 96 | 97 | Compute cica. 98 | Compute eraseNames (fun _ => 0) cica. 99 | 100 | 101 | 102 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/qsort.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testqsort := ELetRec [(1, (EExp (ECase (VVal (VVar 8)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VVar 0));(VVal VNil)])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 6 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 8));(VVal (VVar 9))])) [([(PCons PVar PVar);PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (5, 5))) [(VVal (VVar 0));(VVal (VVar 1));(VVal VNil);(VVal VNil);(VVal (VVar 2))])));([PNil;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 7 | (5, (EExp (ECase (EExp (EValues [(VVal (VVar 8));(VVal (VVar 9));(VVal (VVar 10));(VVal (VVar 11));(VVal (VVar 12))])) [([PVar;(PCons PVar PVar);PVar;PVar;PVar], (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "<"%string))) [(VVal (VVar 1));(VVal (VVar 0))])), (EExp (EApp (VVal (VFunId (8, 5))) [(VVal (VVar 0));(VVal (VVar 2));(EExp (ECons (VVal (VVar 1)) (VVal (VVar 3))));(VVal (VVar 4));(VVal (VVar 5))])));([PVar;(PCons PVar PVar);PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (8, 5))) [(VVal (VVar 0));(VVal (VVar 2));(VVal (VVar 3));(EExp (ECons (VVal (VVar 1)) (VVal (VVar 4))));(VVal (VVar 5))])));([PVar;PNil;PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VVar 2));(VVal (VVar 3))])) (EExp (EApp (VVal (VFunId (6, 2))) [(VVal (VVar 2));(EExp (ECons (VVal (VVar 1)) (VVal (VVar 0))))])))));([PVar;PVar;PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2));(VVal (VVar 3));(VVal (VVar 4))]))])))]))); 8 | (3, (EExp (ECase (EExp (EValues [(VVal (VVar 8));(VVal (VVar 9));(VVal (VVar 10))])) [([(PLit (Integer (0)));PVar;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 1)));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 1))) [(VVal (VVar 2))])) (EExp (EApp (VVal (VFunId (8, 3))) [(VVal (VVar 1));(VVal (VVar 3));(VVal (VVar 0))])))))));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2))]))])))]))); 9 | (1, (EExp (ECase (VVal (VVar 8)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECons (VVal (VLit (Integer (27)))) (EExp (ECons (VVal (VLit (Integer (74)))) (EExp (ECons (VVal (VLit (Integer (17)))) (EExp (ECons (VVal (VLit (Integer (33)))) (EExp (ECons (VVal (VLit (Integer (94)))) (EExp (ECons (VVal (VLit (Integer (18)))) (EExp (ECons (VVal (VLit (Integer (46)))) (EExp (ECons (VVal (VLit (Integer (83)))) (EExp (ECons (VVal (VLit (Integer (65)))) (EExp (ECons (VVal (VLit (Integer (2)))) (EExp (ECons (VVal (VLit (Integer (32)))) (EExp (ECons (VVal (VLit (Integer (53)))) (EExp (ECons (VVal (VLit (Integer (28)))) (EExp (ECons (VVal (VLit (Integer (85)))) (EExp (ECons (VVal (VLit (Integer (99)))) (EExp (ECons (VVal (VLit (Integer (47)))) (EExp (ECons (VVal (VLit (Integer (28)))) (EExp (ECons (VVal (VLit (Integer (82)))) (EExp (ECons (VVal (VLit (Integer (6)))) (EExp (ECons (VVal (VLit (Integer (11)))) (EExp (ECons (VVal (VLit (Integer (55)))) (EExp (ECons (VVal (VLit (Integer (29)))) (EExp (ECons (VVal (VLit (Integer (39)))) (EExp (ECons (VVal (VLit (Integer (81)))) (EExp (ECons (VVal (VLit (Integer (90)))) (EExp (ECons (VVal (VLit (Integer (37)))) (EExp (ECons (VVal (VLit (Integer (10)))) (EExp (ECons (VVal (VLit (Integer (0)))) (EExp (ECons (VVal (VLit (Integer (66)))) (EExp (ECons (VVal (VLit (Integer (51)))) (EExp (ECons (VVal (VLit (Integer (7)))) (EExp (ECons (VVal (VLit (Integer (21)))) (EExp (ECons (VVal (VLit (Integer (85)))) (EExp (ECons (VVal (VLit (Integer (27)))) (EExp (ECons (VVal (VLit (Integer (31)))) (EExp (ECons (VVal (VLit (Integer (63)))) (EExp (ECons (VVal (VLit (Integer (75)))) (EExp (ECons (VVal (VLit (Integer (4)))) (EExp (ECons (VVal (VLit (Integer (95)))) (EExp (ECons (VVal (VLit (Integer (99)))) (EExp (ECons (VVal (VLit (Integer (55)))) (EExp (ECons (VVal (VLit (Integer (29)))) (EExp (ECons (VVal (VLit (Integer (39)))) (EExp (ECons (VVal (VLit (Integer (81)))) (EExp (ECons (VVal (VLit (Integer (90)))) (EExp (ECons (VVal (VLit (Integer (37)))) (EExp (ECons (VVal (VLit (Integer (10)))) (EExp (ECons (VVal (VLit (Integer (0)))) (EExp (ECons (VVal (VLit (Integer (66)))) (EExp (ECons (VVal (VLit (Integer (51)))) (EExp (ECons (VVal (VLit (Integer (7)))) (EExp (ECons (VVal (VLit (Integer (21)))) (EExp (ECons (VVal (VLit (Integer (85)))) (EExp (ECons (VVal (VLit (Integer (27)))) (EExp (ECons (VVal (VLit (Integer (31)))) (EExp (ECons (VVal (VLit (Integer (63)))) (EExp (ECons (VVal (VLit (Integer (75)))) (EExp (ECons (VVal (VLit (Integer (4)))) (EExp (ECons (VVal (VLit (Integer (95)))) (EExp (ECons (VVal (VLit (Integer (99)))) (EExp (ECons (VVal (VLit (Integer (11)))) (EExp (ECons (VVal (VLit (Integer (28)))) (EExp (ECons (VVal (VLit (Integer (61)))) (EExp (ECons (VVal (VLit (Integer (74)))) (EExp (ECons (VVal (VLit (Integer (18)))) (EExp (ECons (VVal (VLit (Integer (92)))) (EExp (ECons (VVal (VLit (Integer (40)))) (EExp (ECons (VVal (VLit (Integer (53)))) (EExp (ECons (VVal (VLit (Integer (59)))) (EExp (ECons (VVal (VLit (Integer (8)))) (VVal VNil))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))) (EExp (EApp (VVal (VFunId (4, 3))) [(VVal (VLit (Integer (500000))));(VVal (VVar 0));(VVal (VLit (Integer (0))))])))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 10 | (1, (EExp (ECase (VVal (VVar 8)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "qsort"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 11 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "qsort"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 12 | (1, (EExp (ECase (VVal (VVar 8)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "qsort"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (4, 1))) [VVal VNil]). 13 | 14 | 15 | -------------------------------------------------------------------------------- /src/BigStep/MapEval.v: -------------------------------------------------------------------------------- 1 | (** 2 | This file show a general property about the evaluation of list transformation. 3 | *) 4 | From CoreErlang.BigStep Require Import SemanticsProofs 5 | Tactics. 6 | 7 | Import ListNotations. 8 | 9 | (* TODO: move these *) 10 | Fixpoint mk_exp_cons (l : list Expression) : Expression := 11 | match l with 12 | | [] => ENil 13 | | e :: es => ECons e (mk_exp_cons es) 14 | end. 15 | 16 | Fixpoint mk_val_cons (l : list Value) : Value := 17 | match l with 18 | | [] => VNil 19 | | e :: es => VCons e (mk_val_cons es) 20 | end. 21 | 22 | Lemma match_value_bind_pattern_var : 23 | forall x v, 24 | match_value_bind_pattern v (PVar x) = [(x, v)]. 25 | Proof. 26 | intros. destruct v; reflexivity. 27 | Qed. 28 | 29 | Section seq_map_eval. 30 | Context {l : list Expression} 31 | {f : Value -> Value} 32 | {f_body : Expression} 33 | {f_var : Var} 34 | {modules : list ErlModule} 35 | {own_module : string} 36 | {vs : list Value}. 37 | 38 | (* This hypothesis could be enough for values in vs, not for necessarily all values *) 39 | Hypothesis f_simulates : 40 | forall i id eff Γ, i < length vs -> 41 | | insert_value Γ (inl f_var) (nth i vs VNil), modules, own_module, id, f_body, eff | -e> | id, inl [f (nth i vs VNil)] , eff |. 42 | Hypothesis param_eval : 43 | forall i env id eff, i < length l -> 44 | | env, modules, own_module, id, nth i l ENil, eff | -e> |id, inl [nth i vs VNil], eff|. 45 | Hypothesis length_eq : length l = length vs. 46 | 47 | Local Definition L : Var := "L"%string. 48 | Local Definition F : Var := "F"%string. 49 | Local Definition H : Var := "H"%string. 50 | Local Definition T : Var := "T"%string. 51 | 52 | Definition map_body : Expression := 53 | ECase (EVar L) [ 54 | ([PNil], ELit (Atom "true"%string), ENil); 55 | ([PCons (PVar H) (PVar T)], ELit (Atom "true"%string), ECons (EApp (EVar F) [EVar H]) 56 | (EApp (EFunId ("map"%string, 2)) [EVar F;EVar T]) 57 | ) 58 | ]. 59 | 60 | Definition map_exp : Expression := 61 | ELetRec [(("map"%string, 2), ([F; L], map_body))] (EApp (EFunId ("map"%string, 2)) [EFun [f_var] f_body; mk_exp_cons l]). 62 | 63 | Theorem map_correct : 64 | | [], modules, own_module, 0, map_exp, [] | -e> | 2, inl [mk_val_cons (map f vs)], []|. 65 | Proof. 66 | apply eval_letrec. cbn. (* remember (VClos _ _ _ _ _) as map_clos. *) 67 | remember [(_, _)] as Γ. 68 | eapply eval_app with (vals := [VClos Γ [] 1 [f_var] f_body; mk_val_cons vs]) 69 | (eff := [[]; []]) 70 | (ids := [2; 2]). 71 | all: simpl; try reflexivity. 72 | * subst Γ. solve. 73 | * reflexivity. 74 | * intros. destruct i. 2: destruct i. 3: lia. 75 | subst Γ. cbn. solve. 76 | cbn. 77 | { (* separate thm *) 78 | clear-param_eval length_eq. revert vs param_eval length_eq. induction l; simpl; intros. 79 | * apply eq_sym, length_zero_iff_nil in length_eq. subst. solve. 80 | * pose proof (param_eval 0 Γ 2 [] ltac:(lia)) as Ha0. simpl in Ha0. 81 | destruct vs. inversion length_eq. simpl in *. 82 | epose proof (IHl0 l1 _ ltac:(lia)) as Rest. clear IHl0. 83 | Unshelve. 2: { 84 | intros. apply (param_eval (S i)). lia. 85 | } 86 | clear -Ha0 Rest. 87 | eapply eval_cons. exact Rest. exact Ha0. 88 | } 89 | * cbn. 90 | { (* separate thm *) 91 | clear param_eval length_eq l. subst Γ. induction vs. 92 | * simpl. eapply eval_case with (i := 0) (vals := [VNil]); 93 | simpl; try lia; try reflexivity; solve. 94 | * epose proof (IHl _) as Rest. 95 | Unshelve. 2: { 96 | intros. apply (f_simulates (S i)). simpl. lia. 97 | } 98 | clear IHl. 99 | simpl. 100 | eapply eval_case with (i := 1) (vals := [VCons a (mk_val_cons l)]); simpl; try lia. 101 | 2: { 102 | destruct a, l; reflexivity. 103 | } 104 | - solve. 105 | - destruct j. 2: lia. intros. inversion H1. 106 | - solve. 107 | - repeat rewrite match_value_bind_pattern_var. simpl. 108 | eapply eval_cons. 109 | + 110 | eapply eval_app with (vals := [VClos 111 | [(inr ("map"%string, 2), 112 | VClos [] [(0, ("map"%string, 2), ([F; L], map_body))] 0 [ 113 | F; L] map_body)] [] 1 [f_var] f_body; mk_val_cons l]) 114 | (eff := [[]; []]) 115 | (ids := [2; 2]); try reflexivity. 116 | ** solve. 117 | ** reflexivity. 118 | ** simpl. intros. destruct i. 2: destruct i. 3: lia. 119 | -- simpl. solve. 120 | -- simpl. solve. 121 | ** simpl. exact Rest. 122 | + eapply eval_app with (vals := [a]) (eff := [[]]) (ids := [2]); try reflexivity. 123 | ** simpl. solve. 124 | ** reflexivity. 125 | ** simpl. destruct i. 2: lia. intros. simpl. solve. 126 | ** simpl. 127 | epose proof (f_simulates 0 2 [] [(inr ("map"%string, 2), 128 | VClos [] [(0, ("map"%string, 2), ([F; L], map_body))] 0 [F; L] map_body); 129 | (inl f_var, a)] ltac:(simpl; lia)) as FF. simpl in FF. 130 | rewrite String.eqb_refl in FF. 131 | exact FF. 132 | } 133 | Qed. 134 | 135 | End seq_map_eval. 136 | 137 | Goal 138 | | [], stdlib, "main"%string, 0, (@map_exp [ELit (Integer 1); ELit (Integer 2)] (ECall (ELit (Atom "erlang"%string)) (ELit (Atom "+"%string)) [EVar "X"%string; ELit (Integer 1)]) "X"%string) , [] | -e> | 2, inl [VCons (VLit (Integer 2)) (VCons (VLit (Integer 3)) VNil) ], [] |. 139 | Proof. 140 | epose proof (@map_correct [ELit (Integer 1); ELit (Integer 2)] 141 | (fun v => 142 | match eval_arith "erlang" "+" [v; VLit (Integer 1)] with 143 | | inl [v] => v 144 | | _ => VLit (Integer 0) 145 | end) 146 | (ECall (ELit (Atom "erlang"%string)) (ELit (Atom "+"%string)) [EVar "X"%string; ELit (Integer 1)]) 147 | "X"%string stdlib "main"%string 148 | [VLit (Integer 1); VLit (Integer 2)] _ _ eq_refl). 149 | now cbn in H0. 150 | Unshelve. 151 | (* f_simulates *) 152 | * intros. simpl in *. destruct i. 2: destruct i. 3: lia. 153 | - simpl. 154 | eapply eval_call with (vals := [VLit (Integer 1); VLit (Integer 1)]) (eff := [eff; eff]) (ids := [id;id]); try reflexivity. 155 | + solve. 156 | + solve. 157 | + destruct i; simpl. 2: destruct i. 3: lia. 158 | ** intros. apply eval_var. 159 | now rewrite get_value_here. 160 | ** intros. solve. 161 | + reflexivity. 162 | + reflexivity. 163 | - simpl. 164 | eapply eval_call with (vals := [VLit (Integer 2); VLit (Integer 1)]) (eff := [eff; eff]) (ids := [id;id]); try reflexivity. 165 | + solve. 166 | + solve. 167 | + destruct i; simpl. 2: destruct i. 3: lia. 168 | ** intros. apply eval_var. 169 | now rewrite get_value_here. 170 | ** intros. solve. 171 | + reflexivity. 172 | + reflexivity. 173 | (* param_eval *) 174 | * intros. simpl in *. destruct i. 2: destruct i. 3: lia. 175 | - solve. 176 | - solve. 177 | Qed. 178 | -------------------------------------------------------------------------------- /src/Syntax.v: -------------------------------------------------------------------------------- 1 | (** 2 | This file includes the abstract syntax of Core Erlang. It defines a number 3 | of notations and shorthands on top of this syntax. The syntax is defined in 4 | nameless variable representation. 5 | *) 6 | 7 | From Coq Require ZArith.BinInt. 8 | From Coq Require Strings.String. 9 | From Coq Require Export FunctionalExtensionality. 10 | 11 | (*Require Import Utf8.*) 12 | 13 | Export ZArith.BinInt. 14 | Export Strings.String. 15 | Export Lists.List. 16 | Require Export Coq.Structures.OrderedType. 17 | Require Export Coq.micromega.Lia 18 | Coq.Lists.List 19 | Coq.Arith.PeanoNat. 20 | 21 | From CoreErlang Require Export Basics. 22 | 23 | Import ListNotations. 24 | 25 | (** We use nats for process identifiers for simplicity. *) 26 | Definition PID : Set := nat. 27 | 28 | (** Currently, the only literals are integers and atoms. *) 29 | Inductive Lit : Set := 30 | | Atom (s: string) 31 | | Integer (x : Z) 32 | (* | Float (q : R) *). 33 | 34 | Coercion Atom : string >-> Lit. 35 | Coercion Integer : Z >-> Lit. 36 | 37 | (** Patterns of the language are its basic data structures (lists, tuples, maps), 38 | literals, and pattern variables. PIDs are _not_ patterns. Due to the 39 | nameless variable representation, pattern variables don't have a name, 40 | neither an index - their index is their position relative to eachother in 41 | an inorder traversal of the pattern. *) 42 | Inductive Pat : Set := 43 | | PVar 44 | (* | PPid (p : PID) *) 45 | | PLit (l : Lit) 46 | | PCons (hd tl : Pat) 47 | | PTuple (l : list Pat) 48 | | PMap (l : list (Pat * Pat)) 49 | | PNil. 50 | 51 | Definition FunId : Set := nat * nat. 52 | Definition Var : Set := nat. 53 | 54 | (** The following type represents Core Erlang expressions and values. It is 55 | mutually inductive, since function values include expressions as their body, 56 | moreover in a small-step semantics it is advantageos to have values as 57 | subexpressions. *) 58 | Inductive Exp : Set := 59 | | VVal (e : Val) 60 | | EExp (e : NonVal) 61 | 62 | with Val: Set := 63 | | VNil 64 | | VLit (l : Lit) 65 | | VPid (p : PID) 66 | | VCons (hd tl : Val) 67 | | VTuple (l : list Val) 68 | | VMap (l : list (Val * Val)) 69 | (** Value sequences are not included here, since they cannot be nested *) 70 | | VVar (n : Var) 71 | | VFunId (n : FunId) 72 | (** Function normalforms: closures. These values contain: 73 | - a list of functions that can be applied recursively by the body expression 74 | - a function reference number 75 | - formal parameter count 76 | - the body *) 77 | | VClos (ext : list (nat * nat * Exp)) 78 | (id : nat) (* Function reference number *) 79 | (params : nat) (* Parameter count *) 80 | (e : Exp) 81 | 82 | with NonVal : Set := 83 | | EFun (vl : nat) (e : Exp) 84 | | EValues (el : list Exp) 85 | | ECons (hd tl : Exp) 86 | | ETuple (l : list Exp) 87 | | EMap (l : list (Exp * Exp)) 88 | | ECall (m f : Exp) (l : list Exp) 89 | | EPrimOp (f : string) (l : list Exp) 90 | | EApp (exp: Exp) (l : list Exp) 91 | | ECase (e : Exp) (l : list ((list Pat) * Exp * Exp)) 92 | | ELet (l : nat) (e1 e2 : Exp) 93 | | ESeq (e1 e2 : Exp) 94 | 95 | | ELetRec (l : list (nat * Exp)) (e : Exp) (* One step reduction *) 96 | | ETry (e1 : Exp) (vl1 : nat) (e2 : Exp) (vl2 : nat) (e3 : Exp) 97 | (** In OTP 23.0, receive expressions were removed from the language primitives, 98 | thus we don't need any other expression to express concurrency. Message 99 | receipts are expressed with primitive operations. 100 | *) 101 | . 102 | 103 | Coercion EExp : NonVal >-> Exp. 104 | Notation "˝ v" := (VVal v) (at level 11). 105 | Notation "° n" := (EExp n) (at level 11). 106 | 107 | Definition inf := 108 | ELetRec 109 | [(0, °EApp (˝VFunId (0, 0)) [])] 110 | (EApp (˝VFunId (0, 0)) []). 111 | 112 | (** Shorthands: *) 113 | Definition VEmptyMap : Val := VMap []. 114 | Definition VEmptyTuple : Val := VTuple []. 115 | Definition EEmptyMap : Exp := EMap []. 116 | Definition EEmptyTuple : Exp := ETuple []. 117 | 118 | Definition ErrorVal : Val := (VLit (Atom "error"%string)). 119 | (* Definition ErrorExp2 : Expression := (ELit (Atom "error"%string)). *) 120 | Definition ErrorExp : Val := (VLit (Atom "error"%string)). 121 | Definition ErrorPat : Pat := PLit(Atom "error"%string). 122 | Notation "'ttrue'" := (VLit "true"%string). 123 | Notation "'ffalse'" := (VLit "false"%string). 124 | Notation "'ok'" := (VLit "ok"%string). 125 | Notation "'link'" := (VLit "link"%string). 126 | Notation "'spawn'" := (VLit "spawn"%string). 127 | Notation "'spawn_link'" := (VLit "spawn_link"%string). 128 | Notation "'unlink'" := (VLit "unlink"%string). 129 | Notation "'exit'" := (VLit "exit"%string). 130 | Notation "'send'" := (VLit "!"%string). 131 | Notation "'normal'" := (VLit "normal"%string). 132 | Notation "'kill'" := (VLit "kill"%string). 133 | Notation "'killed'" := (VLit "killed"%string). 134 | Notation "'EXIT'" := (VLit "EXIT"%string). 135 | Notation "'self'" := (VLit "self"%string). 136 | Notation "'ok'" := (VLit "ok"%string). 137 | Notation "'process_flag'" := (VLit "process_flag"%string). 138 | Notation "'trap_exit'" := (VLit "trap_exit"%string). 139 | Notation "'erlang'" := (VLit "erlang"%string). 140 | Notation "'infinity'" := (VLit "infinity"%string). 141 | 142 | 143 | (** Exception classes in Erlang *) 144 | Inductive ExcClass : Set := 145 | | Error | Throw | Exit. 146 | 147 | (** Exception class to value conversion *) 148 | Definition exclass_to_value (ex : ExcClass) : Val := 149 | match ex with 150 | | Error => VLit (Atom "error"%string) 151 | | Throw => VLit (Atom "throw"%string) 152 | | Exit => VLit (Atom "exit"%string) 153 | end. 154 | 155 | (** Exceptions are triples: 156 | - Exception class 157 | - 1st Value : cause 158 | - 2nd Value : further details *) 159 | Definition Exception : Set := ExcClass * Val * Val. 160 | 161 | (** Commonly used exceptions: *) 162 | Definition badarith (v : Val) : Exception := 163 | (Error, VLit (Atom "badarith"%string), v). 164 | Definition badarg (v : Val) : Exception := 165 | (Error, VLit (Atom "badarg"%string), v). 166 | Definition undef (v : Val) : Exception := 167 | (Error, VLit (Atom "undef"%string), v). 168 | Definition badfun (v : Val) : Exception := 169 | (Error,VLit (Atom "badfun"%string), v). 170 | Definition badarity (v : Val) : Exception := 171 | (Error,VLit (Atom "badarity"%string), v). 172 | Definition if_clause : Exception := 173 | (Error, VLit (Atom "if_clause"%string), ErrorVal). 174 | Definition timeout_value v : Exception := 175 | (Error, VLit (Atom "timeout_value"), v). 176 | 177 | (** The result of the evaluation is a value sequence (or exception). *) 178 | Definition ValSeq := list Val. 179 | 180 | (** Redexes are used in the frame stack semantics (which is a reduction-style 181 | semantics). `RBox` is used to express parameter list evaluation (i.e., in 182 | case of tuples, maps, applications, calls, primops) without code 183 | duplication. 184 | *) 185 | Inductive Redex : Set := 186 | | RExp (e : Exp) 187 | | RValSeq (vs : ValSeq) 188 | | RExc (e : Exception) 189 | | RBox. 190 | 191 | (** Converting a list of functions into a list of closures. *) 192 | Definition convert_to_closlist (l : list (nat * nat * Exp)) : (list Val) := 193 | map (fun '(id,vc,e) => (VClos l id vc e)) l. 194 | -------------------------------------------------------------------------------- /Erl_codes/tests.core: -------------------------------------------------------------------------------- 1 | module 'tests' ['module_info'/0, 2 | 'module_info'/1, 3 | 'eval_letrec1'/0, 4 | %'eval_letrec2'/0, 5 | 'eval_multiple_top_level_funs'/0, 6 | 'eval_multiple_top_level_funs2'/0, 7 | 'top_overwrite'/0, 8 | 'top_no_overwrite'/0, 9 | %'eval_let_func'/0, 10 | 'eval_let_apply'/0, 11 | 'eval_multiple_let'/0, 12 | 'let_eval_1'/0, 13 | 'let_eval_2'/0, 14 | %'let_eval_3'/0, 15 | 'let_eval_4'/0, 16 | 'tuple_eval'/0, 17 | 'apply_top_eval'/0, 18 | 'apply_eval'/0, 19 | 'list_eval'/0, 20 | 'list_eval2'/0, 21 | 'let_eval_overwrite'/0, 22 | 'map_eval'/0, 23 | 'map_eval2'/0, 24 | 'map_eval3'/0, 25 | 'map_eval4'/0, 26 | 'let_closure_apply_eval_without_overwrite'/0, 27 | 'let_closure_apply_eval_without_overwrite2'/0, 28 | 'call_eval'/0, 29 | 'multiple_function_let'/0, 30 | 'case_eval'/0, 31 | 'case_eval2'/0, 32 | 'case_eval_fun'/0, 33 | 'letrec_eval'/0, 34 | 'unnamed_eval'/0, 35 | 'returned_function'/0, 36 | 'returned_recursive_function'/0, 37 | 'returned_function2'/0, 38 | 'returned_recursive_function2'/0, 39 | 'returned_function3'/0, 40 | 'test'/0, 41 | 'weird_apply'/0, 42 | 'sum'/0, 43 | 'letrec_no_replace'/0, 44 | 'seq_eval1'/0, 45 | 'fun4'/0 46 | ] 47 | attributes [%% Line 1 48 | 'file' = 49 | %% Line 1 50 | [{[116|[101|[115|[116|[115|[46|[101|[114|[108]]]]]]]]],1}], 51 | %% Line 2 52 | 'compile' = 53 | %% Line 2 54 | ['export_all']] 55 | 'module_info'/0 = 56 | fun () -> 57 | call 'erlang':'get_module_info' 58 | ('tests') 59 | 'module_info'/1 = 60 | fun (_0) -> 61 | call 'erlang':'get_module_info' 62 | ('tests', _0) 63 | 64 | 'eval_letrec1'/0 = fun() -> 65 | letrec 'x'/1 = fun(X) -> apply 'x'/1(X) in apply 'x'/1({}) 66 | 67 | %%'eval_letrec2'/0 = fun() -> 68 | %% let F = fun(X) -> apply F(X) in apply F({}) 69 | 70 | 'fun1'/0 = fun() -> apply 'fun3'/0() 71 | 'fun2'/0 = fun() -> 42 72 | 'fun3'/0 = fun() -> apply 'fun2'/0() 73 | 74 | 'eval_multiple_top_level_funs'/0 = fun() -> 75 | apply 'fun1'/0() 76 | 77 | 'eval_multiple_top_level_funs2'/0 = fun() -> 78 | letrec 'fun1'/0 = fun() -> apply 'fun3'/0() 79 | 'fun2'/0 = fun() -> 42 80 | 'fun3'/0 = fun() -> apply 'fun2'/0() in 81 | apply 'fun1'/0() 82 | 83 | 'top_overwrite'/0 = fun() -> 84 | letrec 'fun2'/0 = fun() -> 40 in apply 'fun2'/0() 85 | 86 | 'top_no_overwrite'/0 = fun() -> 87 | letrec 'fun2'/1 = fun(X) -> 40 in apply 'fun1'/0() 88 | 89 | %'eval_let_func'/0 = fun() -> 90 | % let X = 42 in 91 | % let = [], ~{}~> in ~{}~ 92 | 93 | 'eval_let_apply'/0 = fun() -> 94 | let X = 42 in 95 | let Y = fun() -> X in apply Y() 96 | 97 | 'eval_multiple_let'/0 = fun() -> 98 | let X = 1 in 99 | let X = 2 in X 100 | 101 | 'let_eval_1'/0 = fun() -> 102 | let X = {} in ~{}~ 103 | 104 | 'let_eval_2'/0 = fun() -> 105 | let X = ~{}~ in 106 | let X = {} in ~{}~ 107 | 108 | %'let_eval_3'/0 = fun() -> 109 | % let X = ~{}~ in 110 | % let = <{}, [], X> in Y 111 | 112 | 'let_eval_4'/0 = fun() -> 113 | let X = 5 in X 114 | 115 | 'tuple_eval'/0 = fun() -> 116 | let = <'foo', {}> in {5, X, Y} 117 | 118 | 'Plus'/2 = fun(X, Y) -> 3 119 | 120 | 'apply_top_eval'/0 = fun() -> apply 'Plus'/2(2,3) 121 | 122 | 'apply_eval'/0 = fun() -> 123 | let = 42, ~{}~> in 124 | apply Minus(X, X) 125 | 126 | 'list_eval'/0 = fun() -> 127 | let X = 5 in 128 | [X|[]] 129 | 130 | 'list_eval2'/0 = fun() -> 131 | let X = 5 in 132 | [X|[X|[]]] 133 | 134 | 'let_eval_overwrite'/0 = fun() -> 135 | let X = fun() -> {} in 136 | let X = 5 in X 137 | 138 | 'map_eval'/0 = fun() -> 139 | let X = 42 in 140 | ~{5 => X}~ 141 | 142 | 'map_eval2'/0 = fun() -> 143 | let X = 42 in 144 | ~{54 => X, X => X}~ 145 | 146 | 'map_eval3'/0 = fun() -> 147 | let X = 5 in 148 | ~{5 => X, X => call 'erlang':'+'(1, X)}~ 149 | 150 | 'map_eval4'/0 = fun() -> 151 | let = 1, fun() -> 2, fun() -> 3> in 152 | ~{Z => 10, X => 11, Y => 12, X => 13}~ 153 | 154 | 'let_closure_apply_eval_without_overwrite'/0 = fun() -> 155 | let X = 42 in 156 | let Y = fun(X) -> X in 157 | let X = 5 in apply Y(7) 158 | 159 | 'let_closure_apply_eval_without_overwrite2'/0 = fun() -> 160 | let X = 42 in 161 | let Y = fun() -> X in 162 | let X = 5 in apply Y() 163 | 164 | 'call_eval'/0 = fun() -> 165 | let X = 5 in call 'erlang':'+'(X, 2) 166 | 167 | 'multiple_function_let'/0 = fun() -> 168 | let Z = call 'erlang':'+'(2, 2) in 169 | let Y = fun() -> Z in 170 | let X = fun() -> apply Y() in 171 | apply X() 172 | 173 | 'case_eval'/0 = fun() -> 174 | let X = {} in 175 | case X of 176 | <5> when 'true' -> 5 177 | <6> when 'true' -> 6 178 | when 'true' -> Z 179 | end 180 | 181 | 'case_eval2'/0 = fun() -> 182 | let X = {} in 183 | case X of 184 | <5> when 'true' -> 5 185 | <6> when 'true' -> 6 186 | when 'false' -> Z 187 | when 'true' -> ~{}~ 188 | end 189 | 190 | 'case_eval_fun'/0 = fun() -> 191 | let Y = 'true' in 192 | let X = fun() -> Y in 193 | case of 194 | <5, 'true'> when 'true' -> 5 195 | <6, 'true'> when 'true' -> 6 196 | when 'true' -> apply Z() 197 | end 198 | 199 | 'fun4'/0 = fun() -> let = <[], let Y = 5 in Y, call 'erlang':'+'(3, 4)> in {X, Y, Z} 200 | 201 | 'letrec_eval'/0 = fun() -> 202 | let X = 42 in 203 | letrec 'fun2'/0 = fun() -> X 204 | 'fun4'/1 = fun(Z) -> Z 205 | in apply 'fun4'/0() 206 | 207 | 'unnamed_eval'/0 = fun() -> 208 | let X = 5 in 209 | apply fun(Y) -> Y(X) 210 | 211 | 'returned_function'/0 = fun () -> 212 | let X = fun() -> fun() -> 5 in 213 | apply apply X()() 214 | 215 | 'returned_recursive_function'/0 = fun () -> 216 | letrec 'fun1'/0 = fun() -> fun() -> 5 in 217 | apply apply 'fun1'/0()() 218 | 219 | 'returned_function2'/0 = fun () -> 220 | let X = 7 in 221 | let X = fun() -> fun() -> X in 222 | apply apply X()() 223 | 224 | 'returned_recursive_function2'/0 = fun () -> 225 | let X = 7 in 226 | letrec 'fun1'/0 = fun() -> fun() -> X in 227 | apply apply 'fun1'/0()() 228 | 229 | 'returned_function3'/0 = fun() -> 230 | let F = fun(X) -> 231 | let Y = call 'erlang':'+'(X, 3) in 232 | fun(Z) -> call 'erlang':'+'(call 'erlang':'+'(X, Y), Z) 233 | in 234 | apply apply F(1)(1) 235 | 236 | 'test'/0 = fun() -> 237 | [call 'io':'fwrite'([97]),call 'io':'fwrite'([98]), call 'io':'fwrite'([99]), 238 | call 'io':'fwrite'([100]),call 'io':'fwrite'([101]), call 'io':'fwrite'([102])] 239 | %%[call 'io':'fwrite'([97])|[call 'io':'fwrite'([98])|[call 'io':'fwrite'([99])|[ 240 | %%call 'io':'fwrite'([100])|[call 'io':'fwrite'([101])|[call 'io':'fwrite'([102])|[] 241 | %%]]]]]] 242 | 243 | 'weird_apply'/0 = fun() -> 244 | letrec 'f'/1 = fun(X) -> case X of 245 | <0> when 'true' -> 5 246 | <1> when 'true' -> apply 'f'/1(0) 247 | when 'true' -> apply 'f'/1(1) 248 | end 249 | in 250 | let X = fun(F) -> letrec 'f'/1 = fun(X) -> 0 in apply F(2) 251 | in 252 | apply X('f'/1) 253 | 254 | 'sum'/0 = fun() -> 255 | letrec 'f'/1 = fun(X) -> case X of 256 | <0> when 'true' -> 0 257 | when 'true' -> call 'erlang':'+'(Y, apply 'f'/1(call 'erlang':'+'(Y, -1))) 258 | end 259 | in apply 'f'/1(3) 260 | 261 | 'letrec_no_replace'/0 = fun() -> 262 | let X = 42 in 263 | letrec 'f'/0 = fun() -> X in 264 | let X = 5 in apply 'f'/0() 265 | 266 | 'seq_eval1'/0 = fun() -> 267 | do let X = 42 in X let Y = 20 in Y 268 | 269 | 270 | end -------------------------------------------------------------------------------- /src/Maps.v: -------------------------------------------------------------------------------- 1 | (** 2 | This file includes a auxiliary definitions to formalise Core Erlang's maps. 3 | 4 | http://erlang.org/pipermail/erlang-questions/2017-October/093981.html 5 | NOTE: 6 | Maps are not ordered in Erlang. However, when comparing two maps, first 7 | keys are compared in ascending order, then the values in key order. 8 | 9 | For simplicity, our representation is ordered, and currently there is no 10 | standard function (beside comparison) whose formalisation exploits this 11 | assumption. 12 | *) 13 | 14 | 15 | 16 | From CoreErlang Require Export Equalities. 17 | Import ListNotations. 18 | 19 | 20 | 21 | (** Building Val maps based on the Val ordering Val_ltb 22 | This function inserts a key-value pair into the map. This operation 23 | overwrites existing keys. 24 | *) 25 | Fixpoint map_insert (k v : Val) (m : list (Val * Val)) 26 | : (list (Val * Val)) := 27 | match m with 28 | | [] => [(k,v)] 29 | | (k',v')::ms => if Val_ltb k k' 30 | then ((k, v)::(k',v')::ms) 31 | else 32 | if Val_eqb k k' 33 | then m 34 | else (k', v')::(map_insert k v ms) 35 | end. 36 | 37 | (** This function collapses a list of value pairs into a map *) 38 | Fixpoint make_val_map (l: list (Val * Val)) : list (Val * Val) := 39 | match l with 40 | | [] => [] 41 | | (k,v)::vs => map_insert k v (make_val_map vs) 42 | end. 43 | 44 | Goal make_val_map [(VLit 1%Z, VLit 1%Z);(VLit 1%Z, VLit 2%Z)] = 45 | [(VLit 1%Z, VLit 2%Z)]. 46 | Proof. simpl. reflexivity. Qed. 47 | 48 | (** 49 | In this section, we define map flattening and deflattening (the inverse of 50 | flattening). For example: 51 | flatten 52 | ~{1 => 2, 2 => 3, 3 => 4}~ =========> [1,2,2,3,3,4] 53 | <========= 54 | deflatten 55 | *) 56 | Section flattening. 57 | Context {A : Type}. 58 | 59 | (** This function flattens the map into a list by appending the elements in 60 | `key₁::value₁::key₂::value₂:: ...` order. *) 61 | Fixpoint flatten_list (l : list (A * A)) : list A := 62 | match l with 63 | | [] => [] 64 | | (x, y)::xs => x::y::(flatten_list xs) 65 | end. 66 | 67 | (** The flattened list has twice the length of the map *) 68 | Lemma length_flatten_list (l : list (A * A)) : 69 | length (flatten_list l) = length l * 2. 70 | Proof. 71 | induction l. 72 | * simpl. auto. 73 | * simpl. destruct a. simpl. lia. 74 | Qed. 75 | 76 | (** The inverse of flattening - works correctly only for lists of even length *) 77 | Fixpoint deflatten_list (l : list A) : list (A * A) := 78 | match l with 79 | | [] => [] 80 | | x::y::xs => (x, y)::deflatten_list xs 81 | | _ => [] 82 | end. 83 | 84 | (** The length of the map created from a list is half the list's length. *) 85 | Lemma deflatten_length : 86 | forall (l : list A), 87 | length (deflatten_list l) = Nat.div2 (length l). 88 | Proof. 89 | induction l using list_length_ind; simpl; auto; destruct l; auto. 90 | destruct l; auto. simpl in *. rewrite H. 2: lia. lia. 91 | Qed. 92 | 93 | (** Inverse properties of `flatten` and `deflatten`. *) 94 | Theorem flatten_deflatten : forall (l : list (A * A)), 95 | deflatten_list (flatten_list l) = l. 96 | Proof. 97 | induction l; simpl; auto. 98 | * destruct a. simpl. now rewrite IHl. 99 | Qed. 100 | 101 | Theorem deflatten_flatten : forall n (l : list A), 102 | length l = 2 * n -> 103 | flatten_list (deflatten_list l) = l. 104 | Proof. 105 | induction n; simpl; intros l H. 106 | * apply length_zero_iff_nil in H. now subst. 107 | * replace (S (n + S (n + 0))) with (S (S (2 * n))) in H by nia. 108 | destruct l. inversion H. destruct l. inversion H. 109 | simpl length in H. simpl. rewrite IHn; [reflexivity|nia]. 110 | Qed. 111 | 112 | (** List elements will respect the same properties after deflattening *) 113 | Lemma deflatten_keeps_prop (P : A -> Prop) : 114 | forall (l : list A), 115 | Forall P l -> 116 | Forall (fun x => P (fst x) /\ P (snd x)) (deflatten_list l). 117 | Proof. 118 | induction l using list_length_ind. 119 | intro HF. 120 | destruct l. 2: destruct l. 121 | * constructor. 122 | * cbn. constructor. 123 | * cbn. inversion HF. inversion H3. subst. 124 | clear HF H3. constructor; auto. 125 | apply H; simpl; auto. 126 | Qed. 127 | 128 | (** The previous property expressed with pattern matching *) 129 | Corollary deflatten_keeps_prop_match (P : A -> Prop) : 130 | forall (l : list A), 131 | Forall P l -> 132 | Forall (fun '(x, y) => P x /\ P y) (deflatten_list l). 133 | Proof. 134 | intros. 135 | apply deflatten_keeps_prop in H. 136 | eapply Forall_impl. 2: eassumption. 137 | intros. now destruct a. 138 | Qed. 139 | 140 | (** Flattening lists also do not affect propositions that were satsified by 141 | the list elements *) 142 | Lemma flatten_keeps_prop (P : A -> Prop) : 143 | forall (l : list (A * A)), 144 | Forall (fun '(x, y) => P x /\ P y) l -> 145 | Forall P (flatten_list l). 146 | Proof. 147 | induction l; intros; simpl in *; auto. 148 | destruct a. 149 | destruct_foralls. destruct H2. constructor; auto. 150 | Qed. 151 | 152 | (** Propositions with list pairs are also kept by deflattening *) 153 | Lemma deflatten_keeps_biprop_match : 154 | forall P (l1 : list A) (l2 : list A), 155 | list_biforall P l1 l2 -> 156 | list_biforall (fun '(x1, y1) '(x2, y2) => P x1 x2 /\ P y1 y2) (deflatten_list l1) (deflatten_list l2). 157 | Proof. 158 | induction l1 using list_length_ind. intros. 159 | inv H0. constructor. 160 | inv H2. constructor. simpl. 161 | constructor. 162 | * now split. 163 | * apply H. slia. assumption. 164 | Qed. 165 | End flattening. 166 | 167 | (** Mapping and deflattening can be swapped *) 168 | Theorem deflatten_map : 169 | forall T1 T2 (f : T1 -> T2) l, 170 | map (fun '(x, y) => (f x, f y)) (deflatten_list l) = 171 | deflatten_list (map f l). 172 | Proof. 173 | induction l using list_length_ind; simpl; auto. 174 | destruct l; simpl; auto. 175 | destruct l; simpl; auto. 176 | rewrite H. reflexivity. slia. 177 | Qed. 178 | 179 | (** Inserting a key-value pair into a map, all three respecting some proposition 180 | results in a map that still respects the proposition. *) 181 | Lemma map_insert_prop : 182 | forall (P : Val * Val -> Prop) l k v, 183 | P (k, v) -> 184 | Forall P l -> 185 | Forall P (map_insert k v l). 186 | Proof. 187 | induction l; intros k v HP HF. 188 | * constructor; auto. 189 | * simpl. destruct a as [k' v']. 190 | destruct_foralls. 191 | break_match_goal. 2: break_match_goal. 192 | - constructor. 2: constructor. all: auto. 193 | - constructor; auto. 194 | - constructor; auto. 195 | Qed. 196 | 197 | (** 198 | Creating a value map from a list of key-value pairs that all respect a 199 | proposition results in a map that still respects the proposition. 200 | *) 201 | Lemma make_val_map_keeps_prop (P : Val * Val -> Prop) : 202 | forall l, 203 | Forall P l -> 204 | Forall P (make_val_map l). 205 | Proof. 206 | induction l; intro H. 207 | * constructor. 208 | * cbn. destruct a. inversion H. subst. clear H. 209 | apply IHl in H3. clear IHl. 210 | now apply map_insert_prop. 211 | Qed. 212 | 213 | (** 214 | Mapping and repeating are interchangeable. 215 | *) 216 | Theorem map_repeat {T Q : Type} : 217 | forall n (f : T -> Q) (x : T), map f (repeat x n) = repeat (f x) n. 218 | Proof. 219 | induction n; intros; cbn; auto; now rewrite IHn. 220 | Qed. 221 | -------------------------------------------------------------------------------- /src/Interpreter/ExampleASTs/coqAST/length_u.v: -------------------------------------------------------------------------------- 1 | From CoreErlang Require Import Syntax. 2 | Import ListNotations. 3 | 4 | 5 | Definition testlength_u := ELetRec [(1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (2, 2))) [(VVal (VLit (Integer (0))));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 6 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([PVar;(PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar PVar)))))))))))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (11))))])) (EExp (EApp (VVal (VFunId (15, 2))) [(VVal (VVar 0));(VVal (VVar 13))])))));([PVar;(PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar PVar))))))))))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (10))))])) (EExp (EApp (VVal (VFunId (14, 2))) [(VVal (VVar 0));(VVal (VVar 12))])))));([PVar;(PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar PVar)))))))))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (9))))])) (EExp (EApp (VVal (VFunId (13, 2))) [(VVal (VVar 0));(VVal (VVar 11))])))));([PVar;(PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar PVar))))))))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (8))))])) (EExp (EApp (VVal (VFunId (12, 2))) [(VVal (VVar 0));(VVal (VVar 10))])))));([PVar;(PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar PVar)))))))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (7))))])) (EExp (EApp (VVal (VFunId (11, 2))) [(VVal (VVar 0));(VVal (VVar 9))])))));([PVar;(PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar PVar))))))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (6))))])) (EExp (EApp (VVal (VFunId (10, 2))) [(VVal (VVar 0));(VVal (VVar 8))])))));([PVar;(PCons PVar (PCons PVar (PCons PVar (PCons PVar (PCons PVar PVar)))))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (5))))])) (EExp (EApp (VVal (VFunId (9, 2))) [(VVal (VVar 0));(VVal (VVar 7))])))));([PVar;(PCons PVar (PCons PVar (PCons PVar (PCons PVar PVar))))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (4))))])) (EExp (EApp (VVal (VFunId (8, 2))) [(VVal (VVar 0));(VVal (VVar 6))])))));([PVar;(PCons PVar (PCons PVar (PCons PVar PVar)))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (3))))])) (EExp (EApp (VVal (VFunId (7, 2))) [(VVal (VVar 0));(VVal (VVar 5))])))));([PVar;(PCons PVar (PCons PVar PVar))], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (2))))])) (EExp (EApp (VVal (VFunId (6, 2))) [(VVal (VVar 0));(VVal (VVar 4))])))));([PVar;(PCons PVar PVar)], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "+"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (5, 2))) [(VVal (VVar 0));(VVal (VVar 3))])))));([PVar;PNil], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 7 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EApp (VVal (VFunId (4, 2))) [(VVal (VVar 0));(VVal VNil)])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 8 | (2, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10))])) [([(PLit (Integer (0)));PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 0)));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (EApp (VVal (VFunId (6, 2))) [(VVal (VVar 0));(EExp (ECons (VVal (VLit (Integer (0)))) (VVal (VVar 2))))])))));([PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1))]))])))]))); 9 | (3, (EExp (ECase (EExp (EValues [(VVal (VVar 9));(VVal (VVar 10));(VVal (VVar 11))])) [([(PLit (Integer (0)));PVar;PVar], (VVal (VLit (Atom "true"%string))), (VVal (VVar 1)));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "-"%string))) [(VVal (VVar 0));(VVal (VLit (Integer (1))))])) (EExp (ELet 1 (EExp (EApp (VVal (VFunId (4, 1))) [(VVal (VVar 2))])) (EExp (EApp (VVal (VFunId (9, 3))) [(VVal (VVar 1));(VVal (VVar 3));(VVal (VVar 0))])))))));([PVar;PVar;PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0));(VVal (VVar 1));(VVal (VVar 2))]))])))]))); 10 | (1, (EExp (ECase (VVal (VVar 9)) [([PNil], (VVal (VLit (Atom "true"%string))), (EExp (ELet 1 (EExp (EApp (VVal (VFunId (2, 1))) [(VVal (VLit (Integer (20000))))])) (EExp (EApp (VVal (VFunId (5, 3))) [(VVal (VLit (Integer (50000))));(VVal (VVar 0));(VVal (VLit (Integer (0))))])))));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 11 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "hipe"%string))) (VVal (VLit (Atom "c"%string))) [(VVal (VLit (Atom "length_u"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))]))); 12 | (0, (EExp (ECase (EExp (EValues [])) [([], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length_u"%string)))])));([], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)))]))])))]))); 13 | (1, (EExp (ECase (VVal (VVar 9)) [([PVar], (VVal (VLit (Atom "true"%string))), (EExp (ECall (VVal (VLit (Atom "erlang"%string))) (VVal (VLit (Atom "get_module_info"%string))) [(VVal (VLit (Atom "length_u"%string)));(VVal (VVar 0))])));([PVar], (VVal (VLit (Atom "true"%string))), (EExp (EPrimOp "match_fail"%string [(EExp (ETuple [(VVal (VLit (Atom "function_clause"%string)));(VVal (VVar 0))]))])))])))] (EApp (VVal (VFunId (5, 1))) [VVal VNil]). 14 | 15 | 16 | --------------------------------------------------------------------------------