├── VERSION ├── docs ├── fsml │ ├── Fsml │ │ ├── .dune-keep │ │ ├── Builtins │ │ │ └── index.html │ │ ├── Tevents │ │ │ ├── Ops │ │ │ │ └── index.html │ │ │ └── index.html │ │ ├── State │ │ │ └── index.html │ │ ├── Fsm_lexer │ │ │ └── index.html │ │ ├── Event │ │ │ └── index.html │ │ ├── Vcd │ │ │ └── index.html │ │ ├── Clock │ │ │ └── index.html │ │ ├── Seqmodel │ │ │ └── index.html │ │ ├── C │ │ │ └── index.html │ │ ├── Action │ │ │ └── index.html │ │ ├── Guard │ │ │ └── index.html │ │ ├── Dot │ │ │ └── index.html │ │ ├── Transition │ │ │ └── index.html │ │ ├── Typing │ │ │ └── index.html │ │ ├── Misc │ │ │ └── index.html │ │ └── Vhdl │ │ │ └── index.html │ ├── Fsml__C │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Action │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Clock │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Dot │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Event │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Expr │ │ └── .dune-keep │ ├── Fsml__Fsm │ │ └── .dune-keep │ ├── Fsml__Guard │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Misc │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Parse │ │ └── .dune-keep │ ├── Fsml__Simul │ │ └── .dune-keep │ ├── Fsml__State │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Types │ │ └── .dune-keep │ ├── Fsml__Typing │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Vcd │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Vhdl │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Builtins │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Fsm_lexer │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Fsm_parser │ │ └── .dune-keep │ ├── Fsml__Seqmodel │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Tevents │ │ ├── .dune-keep │ │ ├── Ops │ │ │ └── index.html │ │ └── index.html │ ├── Fsml__Transition │ │ ├── .dune-keep │ │ └── index.html │ ├── Fsml__Valuation │ │ └── .dune-keep │ └── index.html ├── figs │ ├── genimp.png │ ├── genimp-bis.png │ ├── genimp-wave.png │ └── genimp-defact.png ├── code │ ├── fsm_genimp.h │ ├── fsm_genimp.c │ └── fsm_genimp.vhd └── index.html ├── dune ├── etc └── c │ └── fsml.h ├── src ├── bin │ ├── fsml_top.ml │ ├── Makefile │ └── dune └── lib │ ├── Makefile │ ├── dune │ ├── state.ml │ ├── state.mli │ ├── clock.ml │ ├── builtins.mli │ ├── event.ml │ ├── clock.mli │ ├── event.mli │ ├── action.ml │ ├── action.mli │ ├── guard.ml │ ├── seqmodel.mli │ ├── guard.mli │ ├── transition.ml │ ├── vcd.mli │ ├── transition.mli │ ├── fsm_lexer.mll │ ├── tevents.ml │ ├── dot.mli │ ├── valuation.mli │ ├── seqmodel.ml │ ├── valuation.ml │ ├── tevents.mli │ ├── c.mli │ ├── parse.ml │ ├── ppxs.ml │ ├── misc.ml │ ├── typing.mli │ ├── expr.mli │ ├── vhdl.mli │ ├── types.mli │ ├── simul.mli │ ├── builtins.ml │ ├── simul.ml │ ├── expr.ml │ ├── fsm.mli │ └── dot.ml ├── test ├── ppx │ ├── check_ppx.ml │ ├── dune │ └── test_ppx.ml ├── parsing │ ├── dune │ ├── include_ml │ └── test.ml └── typing │ └── test.ml ├── TODO.md ├── examples ├── ex1 │ ├── Makefile │ ├── Readme.md │ ├── dune │ └── test.ml ├── ex4 │ ├── Makefile │ ├── Readme.md │ ├── dune │ └── test.ml ├── ex5 │ ├── Readme.md │ ├── dune │ ├── Makefile │ ├── test.gtkw │ └── test.ml ├── ex2 │ ├── dune │ ├── c │ │ ├── tb.c │ │ └── Makefile │ ├── Readme.md │ ├── Makefile │ ├── vhdl │ │ ├── Makefile │ │ ├── tb.gtkw │ │ └── tb.vhd │ ├── test.gtkw │ └── test.ml └── ex3 │ ├── dune │ ├── c │ ├── tb.c │ └── Makefile │ ├── Readme.md │ ├── include_ml │ ├── Makefile │ ├── vhdl │ ├── Makefile │ ├── tb.gtkw │ └── tb.vhd │ ├── test.gtkw │ └── test.ml ├── Makefile ├── .gitignore ├── dune-project ├── fsml.opam ├── CHANGES.md └── LICENSE /VERSION: -------------------------------------------------------------------------------- 1 | VERSION=0.3.0 2 | -------------------------------------------------------------------------------- /docs/fsml/Fsml/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__C/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Action/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Clock/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Dot/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Event/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Expr/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Fsm/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Guard/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Misc/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Parse/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Simul/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__State/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Types/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Typing/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Vcd/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Vhdl/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Builtins/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Fsm_lexer/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Fsm_parser/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Seqmodel/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Tevents/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Transition/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Valuation/.dune-keep: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /dune: -------------------------------------------------------------------------------- 1 | (dirs :standard \ attic test) 2 | -------------------------------------------------------------------------------- /etc/c/fsml.h: -------------------------------------------------------------------------------- 1 | #define IN 2 | #define OUT 3 | -------------------------------------------------------------------------------- /src/bin/fsml_top.ml: -------------------------------------------------------------------------------- 1 | let () = Topmain.main () 2 | -------------------------------------------------------------------------------- /test/ppx/check_ppx.ml: -------------------------------------------------------------------------------- 1 | Ppxlib.Driver.standalone (); 2 | -------------------------------------------------------------------------------- /docs/figs/genimp.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jserot/Fsml/HEAD/docs/figs/genimp.png -------------------------------------------------------------------------------- /test/parsing/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules test) 4 | (libraries fsml)) 5 | -------------------------------------------------------------------------------- /docs/figs/genimp-bis.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jserot/Fsml/HEAD/docs/figs/genimp-bis.png -------------------------------------------------------------------------------- /docs/figs/genimp-wave.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jserot/Fsml/HEAD/docs/figs/genimp-wave.png -------------------------------------------------------------------------------- /docs/figs/genimp-defact.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jserot/Fsml/HEAD/docs/figs/genimp-defact.png -------------------------------------------------------------------------------- /src/bin/Makefile: -------------------------------------------------------------------------------- 1 | byte: 2 | dune build fsml_top.bc 3 | 4 | clean: 5 | dune clean 6 | 7 | clobber: clean 8 | @rm -f *~ 9 | -------------------------------------------------------------------------------- /TODO.md: -------------------------------------------------------------------------------- 1 | - add precise column position when reporting PPX parse errors 2 | - support for synchronous actions at the OCaml and C level 3 | -------------------------------------------------------------------------------- /examples/ex1/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune exec ./test.exe 3 | 4 | clean: 5 | dune clean 6 | 7 | clobber: clean 8 | \rm -f *~ 9 | 10 | -------------------------------------------------------------------------------- /examples/ex4/Makefile: -------------------------------------------------------------------------------- 1 | all: 2 | dune exec ./test.exe 3 | 4 | clean: 5 | dune clean 6 | 7 | clobber: clean 8 | \rm -f *~ 9 | 10 | -------------------------------------------------------------------------------- /src/bin/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name fsml_top) 3 | (libraries compiler-libs.toplevel fsml) 4 | (link_flags (-linkall)) 5 | (modes byte)) 6 | 7 | -------------------------------------------------------------------------------- /src/lib/Makefile: -------------------------------------------------------------------------------- 1 | byte: 2 | dune build fsml.cma 3 | 4 | native: 5 | dune build fsml.cmxa 6 | 7 | clean: 8 | dune clean 9 | 10 | clobber: clean 11 | @rm -f *~ 12 | -------------------------------------------------------------------------------- /examples/ex1/Readme.md: -------------------------------------------------------------------------------- 1 | Type `make` to compile and run. 2 | 3 | To test interactively, launch `../../_build/default/src/lib/.utop/utop.exe` and send it phrases from `test.ml` 4 | 5 | -------------------------------------------------------------------------------- /examples/ex4/Readme.md: -------------------------------------------------------------------------------- 1 | Type `make` to compile and run. 2 | 3 | To test interactively, launch `../../_build/default/src/lib/.utop/utop.exe` and send it phrases from `test.ml` 4 | 5 | -------------------------------------------------------------------------------- /examples/ex5/Readme.md: -------------------------------------------------------------------------------- 1 | Type `make` to compile and run. 2 | 3 | To test interactively, launch `../../_build/default/src/lib/.utop/utop.exe` and send it phrases from `test.ml` 4 | 5 | -------------------------------------------------------------------------------- /examples/ex1/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules test) 4 | (libraries fsml yojson ppx_deriving_yojson.runtime) 5 | (preprocess (pps ppx_deriving.show ppx_deriving_yojson ppx_fsm))) 6 | -------------------------------------------------------------------------------- /examples/ex2/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules test) 4 | (libraries fsml yojson ppx_deriving_yojson.runtime) 5 | (preprocess (pps ppx_deriving.show ppx_deriving_yojson ppx_fsm))) 6 | -------------------------------------------------------------------------------- /examples/ex3/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules test) 4 | (libraries fsml yojson ppx_deriving_yojson.runtime) 5 | (preprocess (pps ppx_deriving.show ppx_deriving_yojson ppx_fsm))) 6 | -------------------------------------------------------------------------------- /examples/ex4/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules test) 4 | (libraries fsml yojson ppx_deriving_yojson.runtime) 5 | (preprocess (pps ppx_deriving.show ppx_deriving_yojson ppx_fsm))) 6 | -------------------------------------------------------------------------------- /examples/ex5/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test) 3 | (modules test) 4 | (libraries fsml yojson ppx_deriving_yojson.runtime) 5 | (preprocess (pps ppx_deriving.show ppx_deriving_yojson ppx_fsm))) 6 | -------------------------------------------------------------------------------- /test/ppx/dune: -------------------------------------------------------------------------------- 1 | (executable 2 | (name test_ppx) 3 | (modules test_ppx) 4 | (libraries fsml) 5 | (preprocess (pps ppx_deriving.show ppx_fsm))) 6 | 7 | (executable 8 | (name check_ppx) 9 | (modules check_ppx) 10 | (libraries fsml ppx_fsm)) 11 | -------------------------------------------------------------------------------- /docs/code/fsm_genimp.h: -------------------------------------------------------------------------------- 1 | #ifndef _fsm_gensig_h 2 | #define _fsm_gensig_h 3 | 4 | #include "fsml.h" 5 | 6 | typedef struct { 7 | IN int start; 8 | OUT int s; 9 | int k; 10 | } ctx_t; 11 | 12 | void dump_ctx(ctx_t ctx); 13 | void fsm_gensig(ctx_t *ctx); 14 | 15 | #endif 16 | -------------------------------------------------------------------------------- /examples/ex2/c/tb.c: -------------------------------------------------------------------------------- 1 | #include "genimp.h" 2 | 3 | int main(int argc, char **argv) 4 | { 5 | ctx_t ctx = { 0, 0, 0 }; 6 | dump_ctx(ctx); 7 | fsm_gensig(&ctx); 8 | dump_ctx(ctx); 9 | ctx.start = 1; 10 | fsm_gensig(&ctx); 11 | dump_ctx(ctx); 12 | ctx.start = 0; 13 | for ( int i=0; i<6; i++ ) { 14 | fsm_gensig(&ctx); 15 | dump_ctx(ctx); 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /examples/ex3/c/tb.c: -------------------------------------------------------------------------------- 1 | #include "fsm_pgcd.h" 2 | 3 | int main(int argc, char **argv) 4 | { 5 | ctx_t ctx = { 0, 36, 24, 0, 0 }; 6 | dump_ctx(ctx); 7 | fsm_pgcd(&ctx); 8 | dump_ctx(ctx); 9 | ctx.start = 1; 10 | fsm_pgcd(&ctx); 11 | dump_ctx(ctx); 12 | ctx.start = 0; 13 | while ( ctx.rdy != 1 ) { 14 | fsm_pgcd(&ctx); 15 | dump_ctx(ctx); 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /examples/ex5/Makefile: -------------------------------------------------------------------------------- 1 | DOTVIEWER=open -a Graphviz 2 | VCDVIEWER=gtkwave 3 | 4 | all: run view 5 | 6 | view: 7 | $(DOTVIEWER) test.dot 8 | $(DOTVIEWER) test_bis.dot 9 | 10 | run: 11 | # OCAMLRUNPARAM=b=1 dune exec ./test.exe 12 | dune exec ./test.exe 13 | 14 | clean: 15 | dune clean 16 | \rm -f *.vcd 17 | \rm -f test*.dot 18 | 19 | clobber: clean 20 | \rm -f *~ 21 | 22 | -------------------------------------------------------------------------------- /examples/ex2/c/Makefile: -------------------------------------------------------------------------------- 1 | all: tb 2 | 3 | tb: genimp.o tb.o 4 | gcc -o tb genimp.o tb.o 5 | ./tb 6 | 7 | genimp.o: genimp.h genimp.c 8 | gcc -c -I ../../../etc/c genimp.h genimp.c 9 | 10 | tb.o: genimp.h tb.c 11 | gcc -c -I ../../../etc/c tb.c 12 | 13 | clean: 14 | \rm -f *.o 15 | \rm -f *.gch 16 | \rm -f tb 17 | 18 | clobber: clean 19 | \rm -f *~ 20 | \rm -f genimp.{c,h} 21 | 22 | -------------------------------------------------------------------------------- /examples/ex2/Readme.md: -------------------------------------------------------------------------------- 1 | Type `make` to compile and run (possibly adjusting definitions of `DOTVIEWER` and `VCDVIEWER` in `./Makefile`. 2 | To compile and run the generated `C` code: `cd ./c; make`. 3 | To compile and run the generated `VHDL` code: `cd ./vhdl; make; make view`. 4 | 5 | 6 | To test interactively, launch `../../_build/default/src/lib/.utop/utop.exe` and send it phrases from `test.ml` 7 | 8 | -------------------------------------------------------------------------------- /examples/ex3/Readme.md: -------------------------------------------------------------------------------- 1 | Type `make` to compile and run (possibly adjusting definitions of `DOTVIEWER` and `VCDVIEWER` in `./Makefile`. 2 | To compile and run the generated `C` code: `cd ./c; make`. 3 | To compile and run the generated `VHDL` code: `cd ./vhdl; make; make view`. 4 | 5 | 6 | To test interactively, launch `../../_build/default/src/lib/.utop/utop.exe` and send it phrases from `test.ml` 7 | 8 | -------------------------------------------------------------------------------- /examples/ex3/c/Makefile: -------------------------------------------------------------------------------- 1 | all: tb 2 | 3 | tb: fsm_pgcd.o tb.o 4 | gcc -o tb fsm_pgcd.o tb.o 5 | ./tb 6 | 7 | fsm_pgcd.o: fsm_pgcd.h fsm_pgcd.c 8 | gcc -c -I ../../../etc/c fsm_pgcd.h fsm_pgcd.c 9 | 10 | tb.o: fsm_pgcd.h tb.c 11 | gcc -c -I ../../../etc/c tb.c 12 | 13 | clean: 14 | \rm -f *.o 15 | \rm -f *.gch 16 | \rm -f tb 17 | 18 | clobber: clean 19 | \rm -f *~ 20 | \rm -f fsm_pgcd.{c,h} 21 | 22 | -------------------------------------------------------------------------------- /examples/ex3/include_ml: -------------------------------------------------------------------------------- 1 | #use "topfind";; 2 | #require "base";; 3 | #require "ppxlib";; 4 | #require "yojson";; 5 | #require "ppx_deriving.runtime";; 6 | #require "ppx_deriving_yojson.runtime";; 7 | #directory "../../_build/default/src";; 8 | #directory "../../_build/default/src/.fsml.objs/byte";; 9 | #directory "../../_build/default/src/.ppx_fsm.objs/byte";; 10 | #load "fsml.cma";; 11 | #load "ppxs.cmo";; 12 | 13 | open Fsml 14 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: test doc 2 | 3 | all: build 4 | 5 | build: 6 | dune build src/lib/fsml.cma 7 | dune build src/lib/fsml.cmxa 8 | dune build src/bin/fsml_top.bc 9 | 10 | utop: 11 | dune utop src/lib 12 | 13 | html: README.md 14 | pandoc -t html -o README.html README.md 15 | 16 | doc: 17 | dune build @doc 18 | cp -r _build/default/_doc/_html/* ./docs 19 | 20 | clean: 21 | dune clean 22 | 23 | clobber: clean 24 | \rm -f *~ 25 | 26 | 27 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | config 3 | config-stamp 4 | *.cmi 5 | *.cmo 6 | *.cma 7 | *.annot 8 | *.cmxa 9 | *~ 10 | *.o 11 | *.cf 12 | *.gch 13 | .depend 14 | .merlin 15 | CHANGELOG.html 16 | README.html 17 | HOWTO-PUBLISH 18 | examples/*/test*.dot 19 | examples/*/*.gif 20 | examples/*/c/* 21 | !examples/*/c/Makefile 22 | !examples/*/c/tb.c 23 | examples/*/vhdl/* 24 | !examples/*/vhdl/Makefile 25 | !examples/*/vhdl/tb.vhd 26 | !examples/*/vhdl/tb.gtkw 27 | attic/ 28 | -------------------------------------------------------------------------------- /examples/ex3/Makefile: -------------------------------------------------------------------------------- 1 | DOTVIEWER=open -a Graphviz 2 | VCDVIEWER=gtkwave 3 | 4 | all: run view 5 | 6 | view: 7 | $(DOTVIEWER) test.dot 8 | $(VCDVIEWER) test.vcd test.gtkw >/tmp/$(VCDVIEWER).log 2>&1 9 | 10 | run: 11 | dune exec ./test.exe 12 | 13 | clean: 14 | dune clean 15 | \rm -f *.vcd 16 | \rm -f test*.dot 17 | (cd ./c; make clean) 18 | (cd ./vhdl; make clean) 19 | 20 | clobber: clean 21 | \rm -f *~ 22 | (cd ./c; make clobber) 23 | (cd ./vhdl; make clobber) 24 | 25 | -------------------------------------------------------------------------------- /examples/ex1/test.ml: -------------------------------------------------------------------------------- 1 | open Fsml 2 | 3 | let f1 = [%fsm {| 4 | name: altbit; 5 | states: Init, E0, E1; 6 | inputs: e: bool; 7 | outputs: s: bool ; 8 | trans: 9 | Init -> E0 when e='0'; 10 | Init -> E1 when e='1'; 11 | E0 -> E1 when e='1' with s:='0'; 12 | E0 -> E0 when e='0' with s:='1'; 13 | E1 -> E0 when e='0' with s:='0'; 14 | E1 -> E1 when e='1' with s:='1'; 15 | itrans: -> Init; 16 | |}] 17 | 18 | let _ = Typing.type_check_fsm f1 19 | 20 | let _ = Dot.view f1 21 | -------------------------------------------------------------------------------- /examples/ex2/Makefile: -------------------------------------------------------------------------------- 1 | DOTVIEWER=open -a Graphviz 2 | VCDVIEWER=gtkwave 3 | 4 | all: run view 5 | 6 | view: 7 | $(DOTVIEWER) test.dot 8 | $(DOTVIEWER) test_bis.dot 9 | $(DOTVIEWER) test_ter.dot 10 | $(VCDVIEWER) test.vcd test.gtkw >/tmp/$(VCDVIEWER).log 2>&1 11 | 12 | run: 13 | dune exec ./test.exe 14 | 15 | clean: 16 | dune clean 17 | \rm -f *.vcd 18 | \rm -f test*.dot 19 | (cd ./c; make clean) 20 | (cd ./vhdl; make clean) 21 | 22 | clobber: clean 23 | \rm -f *~ 24 | (cd ./c; make clobber) 25 | (cd ./vhdl; make clobber) 26 | 27 | -------------------------------------------------------------------------------- /docs/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | index 5 | 6 | 7 | 8 | 9 | 10 |
11 |
12 |

OCaml package documentation

13 |
    14 |
  1. fsml
  2. 15 |
16 |
17 |
18 | 19 | -------------------------------------------------------------------------------- /examples/ex2/vhdl/Makefile: -------------------------------------------------------------------------------- 1 | GHDL=ghdl 2 | GHDLOPTS=-fno-color-diagnostics -P$(LIBDIR)/lib/vhdl 3 | VCDVIEWER=gtkwave 4 | 5 | all: run 6 | 7 | run: tb 8 | $(GHDL) -r $(GHDLOPTS) tb --vcd=tb.vcd 9 | 10 | view: run 11 | $(VCDVIEWER) tb.vcd tb.gtkw > /tmp/gtkwave.log 2>&1; echo $$? 12 | 13 | clean: 14 | \rm -f work*.cf 15 | \rm -f *.o 16 | \rm -f tb 17 | \rm -f tb.vcd 18 | \rm -f tb.ghw 19 | 20 | clobber: clean 21 | \rm -f *~ 22 | \rm -f genimp.vhd 23 | \rm -rf html 24 | 25 | tb: genimp.vhd tb.vhd 26 | $(GHDL) -a $(GHDLOPTS) genimp.vhd 27 | $(GHDL) -a $(GHDLOPTS) tb.vhd 28 | $(GHDL) -e $(GHDLOPTS) tb 29 | -------------------------------------------------------------------------------- /examples/ex3/vhdl/Makefile: -------------------------------------------------------------------------------- 1 | GHDL=ghdl 2 | GHDLOPTS=-fno-color-diagnostics -P$(LIBDIR)/lib/vhdl 3 | VCDVIEWER=gtkwave 4 | 5 | all: run 6 | 7 | run: tb 8 | $(GHDL) -r $(GHDLOPTS) tb --vcd=tb.vcd 9 | 10 | view: run 11 | $(VCDVIEWER) tb.vcd tb.gtkw > /tmp/gtkwave.log 2>&1; echo $$? 12 | 13 | clean: 14 | \rm -f work*.cf 15 | \rm -f *.o 16 | \rm -f tb 17 | \rm -f tb.vcd 18 | \rm -f tb.ghw 19 | 20 | clobber: clean 21 | \rm -f *~ 22 | \rm -f fsm_pgcd.vhd 23 | \rm -rf html 24 | 25 | tb: fsm_pgcd.vhd tb.vhd 26 | $(GHDL) -a $(GHDLOPTS) fsm_pgcd.vhd 27 | $(GHDL) -a $(GHDLOPTS) tb.vhd 28 | $(GHDL) -e $(GHDLOPTS) tb 29 | -------------------------------------------------------------------------------- /src/lib/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name fsml) 3 | (public_name fsml) 4 | (modules misc types builtins typing expr valuation state guard action transition dot event tevents fsm clock simul vcd seqmodel c vhdl parse fsm_lexer fsm_parser) 5 | (libraries unix yojson ppx_deriving_yojson.runtime) 6 | (preprocess (pps ppx_deriving.show ppx_deriving_yojson))) 7 | 8 | (ocamllex 9 | (modules fsm_lexer)) 10 | 11 | (menhir 12 | (modules fsm_parser)) 13 | 14 | (library 15 | (name ppx_fsm) 16 | (modules ppxs) 17 | (wrapped false) 18 | (kind ppx_rewriter) 19 | (libraries fsml ppxlib) 20 | (ppx_runtime_libraries fsml) 21 | (preprocess (pps ppxlib.metaquot))) 22 | -------------------------------------------------------------------------------- /examples/ex2/vhdl/tb.gtkw: -------------------------------------------------------------------------------- 1 | [*] 2 | [*] GTKWave Analyzer v3.3.54 (w)1999-2014 BSI 3 | [*] Wed Oct 21 09:55:27 2020 4 | [*] 5 | [dumpfile] "/Users/jserot/Dev/ml/fsml/examples/ex2/vhdl/tb.vcd" 6 | [dumpfile_mtime] "Wed Oct 21 09:55:14 2020" 7 | [dumpfile_size] 730 8 | [savefile] "/Users/jserot/Dev/ml/fsml/examples/ex2/vhdl/tb.gtkw" 9 | [timestart] 0 10 | [size] 1000 600 11 | [pos] -1 -1 12 | *-24.830624 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 13 | [sst_width] 193 14 | [signals_width] 78 15 | [sst_expanded] 1 16 | [sst_vpaned_height] 168 17 | @28 18 | rst 19 | clk 20 | @29 21 | start 22 | @28 23 | s 24 | [pattern_trace] 1 25 | [pattern_trace] 0 26 | -------------------------------------------------------------------------------- /examples/ex2/test.gtkw: -------------------------------------------------------------------------------- 1 | [*] 2 | [*] GTKWave Analyzer v3.3.54 (w)1999-2014 BSI 3 | [*] Sat Aug 22 16:52:53 2020 4 | [*] 5 | [dumpfile] "/Users/jserot/Dev/ml/fsml/examples/ex2/test.vcd" 6 | [dumpfile_mtime] "Sat Aug 22 16:52:27 2020" 7 | [dumpfile_size] 339 8 | [savefile] "/Users/jserot/Dev/ml/fsml/examples/ex2/test.gtkw" 9 | [timestart] 0 10 | [size] 981 293 11 | [pos] 86 72 12 | *-1.247251 7 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 13 | [sst_width] 193 14 | [signals_width] 111 15 | [sst_expanded] 1 16 | [sst_vpaned_height] 60 17 | @28 18 | top.clk 19 | top.start 20 | @29 21 | top.state 22 | @24 23 | top.k[7:0] 24 | @28 25 | top.s 26 | [pattern_trace] 1 27 | [pattern_trace] 0 28 | -------------------------------------------------------------------------------- /examples/ex5/test.gtkw: -------------------------------------------------------------------------------- 1 | [*] 2 | [*] GTKWave Analyzer v3.3.54 (w)1999-2014 BSI 3 | [*] Sat Aug 22 16:52:53 2020 4 | [*] 5 | [dumpfile] "/Users/jserot/Dev/ml/fsml/examples/ex2/test.vcd" 6 | [dumpfile_mtime] "Sat Aug 22 16:52:27 2020" 7 | [dumpfile_size] 339 8 | [savefile] "/Users/jserot/Dev/ml/fsml/examples/ex2/test.gtkw" 9 | [timestart] 0 10 | [size] 981 293 11 | [pos] 86 72 12 | *-1.247251 7 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 13 | [sst_width] 193 14 | [signals_width] 111 15 | [sst_expanded] 1 16 | [sst_vpaned_height] 60 17 | @28 18 | top.clk 19 | top.start 20 | @29 21 | top.state 22 | @24 23 | top.k[7:0] 24 | @28 25 | top.s 26 | [pattern_trace] 1 27 | [pattern_trace] 0 28 | -------------------------------------------------------------------------------- /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 2.6) 2 | (name fsml) 3 | (source (github jserot/fsml)) 4 | (license MIT) 5 | (authors "Jocelyn Sérot ") 6 | (maintainers "Jocelyn Sérot ") 7 | (bug_reports "jocelyn.serot@uca.fr") 8 | (homepage "http://github.com/jserot/fsml") 9 | (documentation "http://jserot.github.io/fsml") 10 | (using menhir 2.0) 11 | (allow_approximate_merlin) 12 | 13 | (package 14 | (name fsml) 15 | (synopsis "A library for describing and describing synchronous finite state machines") 16 | (depends 17 | (ppxlib (>= 0.13.0)) 18 | (ppx_deriving_yojson (>= 3.5.3)) 19 | (menhir (>= 20200624)) 20 | (ocaml (>= 4.10)))) 21 | 22 | (generate_opam_files true) 23 | -------------------------------------------------------------------------------- /examples/ex3/vhdl/tb.gtkw: -------------------------------------------------------------------------------- 1 | [*] 2 | [*] GTKWave Analyzer v3.3.54 (w)1999-2014 BSI 3 | [*] Fri Aug 14 13:12:27 2020 4 | [*] 5 | [dumpfile] "/Users/jserot/Dev/ml/fsml/examples/ex3/vhdl/tb.vcd" 6 | [dumpfile_mtime] "Fri Aug 14 13:12:05 2020" 7 | [dumpfile_size] 948 8 | [savefile] "/Users/jserot/Dev/ml/fsml/examples/ex3/vhdl/tb.gtkw" 9 | [timestart] 0 10 | [size] 1000 600 11 | [pos] -1 -1 12 | *-24.932140 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 13 | [sst_width] 193 14 | [signals_width] 124 15 | [sst_expanded] 1 16 | [sst_vpaned_height] 168 17 | @24 18 | rst 19 | @28 20 | clk 21 | start 22 | @29 23 | rdy 24 | @24 25 | m[31:0] 26 | n[31:0] 27 | r[31:0] 28 | [pattern_trace] 1 29 | [pattern_trace] 0 30 | -------------------------------------------------------------------------------- /examples/ex5/test.ml: -------------------------------------------------------------------------------- 1 | (* This example illustrates the [Fsm.defactorize] function. 2 | It converts the example given in ../ex2 in a variable-less FSM. 3 | This is possible because the local variable [k] is here given an enumerable type. *) 4 | 5 | open Fsml 6 | 7 | let f = [%fsm {| 8 | name: gensig; 9 | states: E0 with s='0', E1 with s='1'; 10 | inputs: start: bool; 11 | outputs: s: bool; 12 | vars: k: int<0..4>; 13 | trans: 14 | E0 -> E1 when start='1' with k:=0; 15 | E1 -> E1 when k<4 with k:=k+1; 16 | E1 -> E0 when k=4; 17 | itrans: -> E0; 18 | |}] 19 | 20 | let _ = Dot.write "test.dot" f 21 | 22 | let f_bis = Fsm.defactorize ~vars:["k",Expr.Int 0] f 23 | 24 | let _ = Dot.write "test_bis.dot" f_bis 25 | -------------------------------------------------------------------------------- /docs/code/fsm_genimp.c: -------------------------------------------------------------------------------- 1 | #include "fsm_gensig.h" 2 | #include 3 | 4 | void dump_ctx(ctx_t ctx) 5 | { 6 | printf("start=%d s=%d k=%d\n", ctx.start, ctx.s, ctx.k); 7 | } 8 | 9 | void fsm_gensig(ctx_t *ctx) 10 | { 11 | static int k; 12 | static enum { E0, E1 } state = E0; 13 | static int _init = 1; 14 | if ( _init ) { 15 | ctx->s=0; 16 | _init=0; 17 | } 18 | switch ( state ) { 19 | case E0: 20 | if ( ctx->start==1 ) { 21 | k=0; 22 | ctx->s=1; 23 | state = E1; 24 | } 25 | break; 26 | case E1: 27 | if ( k<4 ) { 28 | k=k+1; 29 | } 30 | else if ( k==4 ) { 31 | ctx->s=0; 32 | state = E0; 33 | } 34 | break; 35 | } 36 | ctx->k = k; 37 | }; 38 | -------------------------------------------------------------------------------- /examples/ex3/test.gtkw: -------------------------------------------------------------------------------- 1 | [*] 2 | [*] GTKWave Analyzer v3.3.54 (w)1999-2014 BSI 3 | [*] Sun Aug 23 10:01:39 2020 4 | [*] 5 | [dumpfile] "/Users/jserot/Dev/ml/fsml/examples/ex3/test.vcd" 6 | [dumpfile_mtime] "Sat Aug 22 16:58:51 2020" 7 | [dumpfile_size] 435 8 | [savefile] "/Users/jserot/Dev/ml/fsml/examples/ex3/test.gtkw" 9 | [timestart] 0 10 | [size] 1000 600 11 | [pos] -1 -1 12 | *-1.569179 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 -1 13 | [sst_width] 193 14 | [signals_width] 81 15 | [sst_expanded] 1 16 | [sst_vpaned_height] 168 17 | @28 18 | top.clk 19 | @24 20 | top.m[7:0] 21 | top.n[7:0] 22 | @28 23 | top.start 24 | top.state 25 | @24 26 | top.a[7:0] 27 | top.b[7:0] 28 | @29 29 | top.rdy 30 | @24 31 | top.r[7:0] 32 | [pattern_trace] 1 33 | [pattern_trace] 0 34 | -------------------------------------------------------------------------------- /test/parsing/include_ml: -------------------------------------------------------------------------------- 1 | #use "topfind";; 2 | #require "yojson";; 3 | #require "ppx_deriving.runtime";; 4 | #require "ppx_deriving_yojson.runtime";; 5 | #directory "../../_build/default/src";; 6 | #directory "../../_build/default/src/.fsml.objs/byte";; 7 | #load "fsml__Misc.cmo";; 8 | #load "fsml__Mylexing.cmo";; 9 | #load "fsml__Expr.cmo";; 10 | #load "fsml__State.cmo";; 11 | #load "fsml__Guard.cmo";; 12 | #load "fsml__Action.cmo";; 13 | #load "fsml__Transition.cmo";; 14 | #load "fsml__Dot.cmo";; 15 | #load "fsml__Events.cmo";; 16 | #load "fsml__Stimuli.cmo";; 17 | #load "fsml__Fsm.cmo";; 18 | #load "fsml__Simul.cmo";; 19 | #load "fsml__Seqmodel.cmo";; 20 | #load "fsml__C.cmo";; 21 | #load "fsml__Vhdl.cmo";; 22 | #load "fsml__Fsm_parser.cmo";; 23 | #load "fsml__Fsm_lexer.cmo";; 24 | #load "fsml.cmo";; 25 | 26 | open Fsml 27 | -------------------------------------------------------------------------------- /test/parsing/test.ml: -------------------------------------------------------------------------------- 1 | (* #use "include_ml" *) 2 | 3 | open Fsml 4 | 5 | let print p x = Printf.printf "%s\n" @@ match x with Result.Ok x -> p x | Result.Error _ -> "" 6 | 7 | let () = 8 | Parse.action "rdy:=1" |> print Action.show; 9 | Parse.transition "S0 -> S1 when start=1, k=0 with rdy:=1, k:=k+1" |> print Transition.show; 10 | Parse.fsm " 11 | name: altbit; 12 | states: Init, E0, E1; 13 | inputs: e; 14 | outputs: s; 15 | trans: 16 | Init -> E0 when e=0; 17 | Init -> E1 when e=1; 18 | E0 -> E1 when e=1 with s:=0; 19 | E0 -> E0 when e=0 with s:=1; 20 | E1 -> E0 when e=0 with s:=0; 21 | E1 -> E1 when e=1 with s:=1; 22 | itrans: -> Init; 23 | " |> print Fsm.show; 24 | Parse.stimuli "*; a:=1,b:=1; c:=2; *" |> print Stimuli.to_string 25 | 26 | -------------------------------------------------------------------------------- /docs/fsml/index.html: -------------------------------------------------------------------------------- 1 | 2 | index (fsml.index)

fsml index

Library fsml

The entry point of this library is the module: Fsml.

-------------------------------------------------------------------------------- /fsml.opam: -------------------------------------------------------------------------------- 1 | # This file is generated by dune, edit dune-project instead 2 | opam-version: "2.0" 3 | synopsis: 4 | "A library for describing and describing synchronous finite state machines" 5 | maintainer: ["Jocelyn Sérot "] 6 | authors: ["Jocelyn Sérot "] 7 | license: "MIT" 8 | homepage: "http://github.com/jserot/fsml" 9 | doc: "http://jserot.github.io/fsml" 10 | bug-reports: "jocelyn.serot@uca.fr" 11 | depends: [ 12 | "dune" {>= "2.6"} 13 | "ppxlib" {>= "0.13.0"} 14 | "ppx_deriving_yojson" {>= "3.5.3"} 15 | "menhir" {>= "20200624"} 16 | "ocaml" {>= "4.10"} 17 | ] 18 | build: [ 19 | ["dune" "subst"] {pinned} 20 | [ 21 | "dune" 22 | "build" 23 | "-p" 24 | name 25 | "-j" 26 | jobs 27 | "@install" 28 | "@runtest" {with-test} 29 | "@doc" {with-doc} 30 | ] 31 | ] 32 | dev-repo: "git+https://github.com/jserot/fsml.git" 33 | -------------------------------------------------------------------------------- /CHANGES.md: -------------------------------------------------------------------------------- 1 | # Changes 2 | 3 | # 0.3.0 (Mar 10, 2021) 4 | * output valuations can now be added to states (see for inst. `examples/ex{2,3}`) 5 | * added functions `Fsm.mealy_outps` and `Fsm.moore_outps` to move output valuations 6 | from state to transitions and _vice versa_ 7 | * optional range attribute for `int` type (ex: `var k: int<0..7>`) 8 | * added function `Fsm.defactorize` to defactorize an FSM wrt. to local variables (see `examples/ex5`) 9 | * build now also builds a custom `utop` toplevel (which can be used, for instance, to evaluate the 10 | examples in `./examples/*` interactively) 11 | 12 | 13 | # 0.2.1 (Oct 21, 2020) 14 | * updated interface for functions `C.write` and `Vhdl.write` 15 | * distribution now correctly includes Makefile and testbenchs in examples `c` and `vhdl` subdirs 16 | 17 | # 0.2 (Aug 14, 2020) 18 | * first "public" version 19 | 20 | # 0.1 (Aug 8, 2020) 21 | * initial version 22 | -------------------------------------------------------------------------------- /src/lib/state.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type t = string 14 | [@@deriving show {with_path=false}, yojson] 15 | -------------------------------------------------------------------------------- /test/typing/test.ml: -------------------------------------------------------------------------------- 1 | #use "topfind";; 2 | #require "yojson";; 3 | #require "ppx_deriving.runtime";; 4 | #require "ppx_deriving_yojson.runtime";; 5 | #directory "../../_build/default/src";; 6 | #directory "../../_build/default/src/.fsml.objs/byte";; 7 | #load "fsml.cma";; 8 | 9 | open Fsml 10 | open Fsm 11 | 12 | let f = Parse.fsm " 13 | name: pgcd; 14 | states: Idle, Comp; 15 | inputs: 16 | start: bool, 17 | m: uint<8>; 18 | outputs: 19 | rdy: bool, 20 | r: uint<8>; 21 | vars: 22 | a: uint<8>; 23 | trans: 24 | Idle -> Comp when start='0' with a:=m, rdy:='0'; 25 | Comp -> Idle when a=0 with rdy:='1', r:=a+a; 26 | itrans: -> Idle with rdy:='1'; 27 | " |> Typing.type_check_fsm 28 | 29 | let _ = Dot.view f 30 | let _ = Vhdl.write ~fname:"test1" f 31 | let _ = Vhdl.cfg.Vhdl.use_numeric_std <- true 32 | let _ = Vhdl.write ~fname:"test2" f 33 | 34 | -------------------------------------------------------------------------------- /src/lib/state.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 FSM states} *) 14 | 15 | type t = string 16 | [@@deriving show {with_path=false}, yojson] 17 | 18 | -------------------------------------------------------------------------------- /docs/code/fsm_genimp.vhd: -------------------------------------------------------------------------------- 1 | library ieee; 2 | use ieee.std_logic_1164.all; 3 | 4 | entity gensig is 5 | port( 6 | start: in std_logic; 7 | s: out std_logic; 8 | clk: in std_logic; 9 | rst: in std_logic 10 | ); 11 | end entity; 12 | 13 | architecture RTL of gensig is 14 | type t_state is ( E0, E1 ); 15 | signal state: t_state; 16 | begin 17 | process(rst, clk) 18 | variable k: integer range -128 to 127; 19 | begin 20 | if ( rst='1' ) then 21 | state <= E0; 22 | s <= '0'; 23 | elsif rising_edge(clk) then 24 | case state is 25 | when E0 => 26 | if ( start='1' ) then 27 | k := 0; 28 | s <= '1'; 29 | state <= E1; 30 | end if; 31 | when E1 => 32 | if ( k<4 ) then 33 | k := k+1; 34 | elsif ( k=4 ) then 35 | s <= '0'; 36 | state <= E0; 37 | end if; 38 | end case; 39 | end if; 40 | end process; 41 | end architecture; 42 | -------------------------------------------------------------------------------- /src/lib/clock.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type clk = int 14 | [@@deriving show {with_path=false}] 15 | 16 | type 'a clocked = clk * 'a 17 | [@@deriving show {with_path=false}] 18 | -------------------------------------------------------------------------------- /src/lib/builtins.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** Builtin environments *) 14 | 15 | val typing_env: (string * Types.typ_scheme) list 16 | 17 | val eval_env: (string * Expr.e_val) list 18 | -------------------------------------------------------------------------------- /test/ppx/test_ppx.ml: -------------------------------------------------------------------------------- 1 | open Fsml 2 | 3 | let print_t s = 4 | s |> Transition.show |> print_endline 5 | 6 | let print_f s = 7 | s |> Fsm.show |> print_endline 8 | 9 | let print_s s = 10 | s |> Stimuli.to_string |> print_endline 11 | 12 | let () = 13 | print_t [%fsm_trans "S0 -> S1"]; 14 | print_t [%fsm_trans "S0 -> S1 when c=1"]; 15 | print_t [%fsm_trans "S0 -> S1 when c=1 with k:=k+1"]; 16 | print_t [%fsm_trans "S0 -> S1 when c=1,u<2 with k:=k+1,rdy:=0"]; 17 | (* print [%fsm_trans "S0 --> S1"] *) 18 | print_f [%fsm {| 19 | name: altbit; 20 | states: Init, E0, E1; 21 | inputs: e; 22 | outputs: s; 23 | trans: 24 | Init -> E0 when e=0; 25 | Init -> E1 when e=1; 26 | E0 -> E1 when e=1 with s:=0; 27 | E0 -> E0 when e=0 with s:=1; 28 | E1 -> E0 when e=0 with s:=0; 29 | E1 -> E1 when e=1 with s:=1; 30 | itrans: -> Init; 31 | |}]; 32 | print_s [%fsm_stim {| *; start:=1,rdy:=0; *; start:=0 |}] 33 | 34 | -------------------------------------------------------------------------------- /src/lib/event.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type t = Expr.ident * Expr.e_val 14 | [@@deriving show {with_path=false}] 15 | 16 | let to_string a = match a with 17 | | (id, v) -> id ^ ":=" ^ Expr.string_of_value v 18 | -------------------------------------------------------------------------------- /src/lib/clock.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Clock} *) 14 | 15 | type clk = int 16 | [@@deriving show {with_path=false}] 17 | (** Clock cycle counter *) 18 | 19 | type 'a clocked = clk * 'a 20 | [@@deriving show {with_path=false}] 21 | -------------------------------------------------------------------------------- /src/lib/event.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Simulation events} *) 14 | 15 | type t = Expr.ident * Expr.e_val 16 | [@@deriving show {with_path=false}] 17 | (** [(id,v)] means that input, output or local variable [id] take value [v] *) 18 | 19 | (** {2 Printer} *) 20 | 21 | val to_string: t -> string 22 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Builtins/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Builtins (fsml.Fsml__Builtins)

Module Fsml__Builtins

Builtin environments

val typing_env : (string * Fsml.Types.typ_scheme) list
val eval_env : (string * Fsml.Expr.e_val) list
-------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | MIT License 2 | 3 | Copyright (c) 2020-now Jocelyn SEROT (jocelyn.serot@uca.fr) 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /examples/ex4/test.ml: -------------------------------------------------------------------------------- 1 | (* This example shows how to define parameterized FSM builders. 2 | Here, [genimp n] has the same behavior of the [gensig] FSM defined in [../ex2] but uses 3 | [n] states instead of a local variable. 4 | Note the use of the [fsm_trans] and [fsm_action] PPXs. *) 5 | 6 | open Fsml 7 | open Fsm 8 | 9 | let list_make f lo hi = 10 | (* [list_make f lo hi] is [[f lo; f (lo+1); ...; f hi]] *) 11 | let rec mk i = if i <= hi then f i :: mk (i+1) else [] in 12 | mk lo 13 | 14 | let genimp n = 15 | let mk_state i = "E" ^ string_of_int i in 16 | let mk_attr_state i = mk_state i, [] in 17 | let mk_trans i = (mk_state i, [], [], mk_state (i+1)) in 18 | { 19 | id="gensig"; 20 | states=("E0",[]) :: list_make mk_attr_state 1 n; 21 | itrans="E0", [[%fsm_action "s:='0'"]]; 22 | inps=["start", Types.TyBool]; 23 | outps=["s", Types.TyBool]; 24 | vars=[]; (* No local var here *) 25 | trans= 26 | [ [%fsm_trans "E0 -> E1 when start='1' with s:='1'"]; 27 | (mk_state n, [], [[%fsm_action "s:='0'"]], "E0") ] 28 | @ list_make mk_trans 1 (n-1); 29 | } 30 | 31 | let f = genimp 4 32 | 33 | let _ = Dot.view f 34 | -------------------------------------------------------------------------------- /docs/fsml/Fsml/Builtins/index.html: -------------------------------------------------------------------------------- 1 | 2 | Builtins (fsml.Fsml.Builtins)

Module Fsml.Builtins

val typing_env : (string * Types.typ_scheme) list
val eval_env : (string * Expr.e_val) list
-------------------------------------------------------------------------------- /src/lib/action.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type t = 14 | | Assign of Expr.ident * Expr.t (* var/i/o, value *) 15 | [@@deriving show {with_path=false}, yojson] 16 | 17 | let to_string a = match a with 18 | | Assign (id, expr) -> id ^ ":=" ^ Expr.to_string expr 19 | 20 | (* Simulation *) 21 | 22 | let perform env a = match a with 23 | | Assign (id, expr) -> [ id, Expr.eval env expr ] 24 | -------------------------------------------------------------------------------- /examples/ex3/test.ml: -------------------------------------------------------------------------------- 1 | open Fsml 2 | 3 | let f3 = [%fsm {| 4 | name: pgcd; 5 | states: Idle with rdy='1', Comp with rdy='0'; 6 | inputs: 7 | start: bool, 8 | m: uint<8>, 9 | n: uint<8>; 10 | outputs: 11 | rdy: bool, 12 | r: uint<8>; 13 | vars: 14 | a: uint<8>, 15 | b: uint<8>; 16 | trans: 17 | Idle -> Comp when start='1' with a:=m, b:=n; 18 | Comp -> Comp when a Comp when a>b with a:=a-b; 20 | Comp -> Idle when a=b with r:=a; 21 | itrans: -> Idle; 22 | |}] 23 | 24 | let _ = Dot.write "test.dot" f3 25 | 26 | (* Let's simulate it *) 27 | 28 | let st = 29 | Tevents.merge [ 30 | [%fsm_stim "start: 0,'0'; 1,'1'; 2,'0'"]; 31 | [%fsm_stim "m: 0,36"]; 32 | [%fsm_stim "n: 0,24"]; 33 | ] 34 | 35 | open Tevents.Ops 36 | 37 | let res, _ = Simul.run ~stop_when:[%fsm_guards {|rdy='1',clk>5|}] ~stim:st f3 38 | let _ = List.iter (fun t -> Printf.printf "%s\n" (Tevents.show t)) (st @@@ res) 39 | let _ = Vcd.write ~fname:"test.vcd" ~fsm:f3 (st @@@ res) 40 | 41 | (* Code generation *) 42 | 43 | let () = C.write ~dir:"./c" ~prefix:"fsm_pgcd" f3 44 | let () = Vhdl.write ~dir:"./vhdl" ~prefix:"fsm_pgcd" f3 45 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Tevents/Ops/index.html: -------------------------------------------------------------------------------- 1 | 2 | Ops (fsml.Fsml__Tevents.Ops)

Module Fsml__Tevents.Ops

val (@@@) : t list -> t list -> t list

The @@@ infix operator merges two sequences of TES wrt. clock cycles. Ex: [(0,[x:=1]); (2;[x:=0])] @@@ [(1,[y:=1]); (2;y:=0)] gives [(0,[x:=1]); (1,[y:=1]); (2,[x:=0;y:=0])].

-------------------------------------------------------------------------------- /docs/fsml/Fsml/Tevents/Ops/index.html: -------------------------------------------------------------------------------- 1 | 2 | Ops (fsml.Fsml.Tevents.Ops)

Module Tevents.Ops

val (@@@) : t list -> t list -> t list

The @@@ infix operator merges two sequences of TES wrt. clock cycles. Ex: [(0,[x:=1]); (2;[x:=0])] @@@ [(1,[y:=1]); (2;y:=0)] gives [(0,[x:=1]); (1,[y:=1]); (2,[x:=0;y:=0])].

-------------------------------------------------------------------------------- /examples/ex2/test.ml: -------------------------------------------------------------------------------- 1 | open Fsml 2 | 3 | let f2 = [%fsm {| 4 | name: gensig; 5 | states: E0 with s='0', E1 with s='1'; 6 | inputs: start: bool; 7 | outputs: s: bool; 8 | vars: k: int<8>; 9 | trans: 10 | E0 -> E1 when start='1' with k:=0; 11 | E1 -> E1 when k<4 with k:=k+1; 12 | E1 -> E0 when k=4; 13 | itrans: -> E0; 14 | |}] 15 | 16 | let _ = Dot.write "test.dot" f2 17 | 18 | (* Simulation *) 19 | 20 | let stim = [%fsm_stim {|start: 0,'0'; 1,'1'; 2,'0'|}] 21 | 22 | open Tevents.Ops 23 | 24 | let res, _ = Simul.run ~stop_after:8 ~stim:stim f2 25 | let _ = List.iter (fun t -> Printf.printf "%s\n" (Tevents.show t)) (stim @@@ res) 26 | let _ = Vcd.write ~fname:"test.vcd" ~fsm:f2 (stim @@@ res) 27 | 28 | (* Code generation *) 29 | 30 | let () = C.write ~dir:"./c" ~prefix:"genimp" f2 31 | let () = Vhdl.write ~dir:"./vhdl" ~prefix:"genimp" f2 32 | 33 | (* Transformation to Mealy-style FSM (with output assignation on transitions instead of states) *) 34 | 35 | let f2bis = Fsm.mealy_outps ~outps:["s"] f2 36 | 37 | let _ = Dot.write "test_bis.dot" f2bis 38 | 39 | (* Back to Moore-style *) 40 | 41 | let f2ter = Fsm.moore_outps ~outps:["s"] f2bis 42 | 43 | let _ = Dot.write "test_ter.dot" f2ter 44 | 45 | 46 | 47 | -------------------------------------------------------------------------------- /src/lib/action.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Transition actions} *) 14 | 15 | type t = 16 | | Assign of Expr.ident * Expr.t 17 | [@@deriving show {with_path=false}, yojson] 18 | (** The type of actions associated to FSM transitions *) 19 | 20 | (** {2 Printer} *) 21 | 22 | val to_string: t -> string 23 | 24 | (** {2 Simulation} *) 25 | 26 | val perform: Expr.env -> t -> Event.t list 27 | (** [perform env a] performs action [a] in the context of environment [env] 28 | returning a list of resulting events. *) 29 | -------------------------------------------------------------------------------- /src/lib/guard.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type t = Expr.t 14 | (* Note: ideally, this should be [bool Expr.t] where [t] is defined as a GADT. 15 | Unfortunately, GADTs are not supported by most of [deriving] PPX extensions :( 16 | See branch [gadt] for a preliminary attempt *) 17 | [@@deriving show {with_path=false}, yojson] 18 | 19 | exception Illegal_guard_expr of Expr.t 20 | 21 | let eval env exp = 22 | match Expr.eval env exp with 23 | | Expr.Bool b -> b 24 | | _ -> raise (Illegal_guard_expr exp) 25 | 26 | let to_string exp = Expr.to_string exp 27 | 28 | -------------------------------------------------------------------------------- /src/lib/seqmodel.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Sequential model (used by C and VHDL backends)} *) 14 | 15 | type t = { 16 | m_name: string; 17 | m_states: (string * Valuation.t) list; 18 | m_inps: (string * Types.t) list; 19 | m_outps: (string * Types.t) list; 20 | m_vars: (string * Types.t) list; 21 | m_init: State.t * Action.t list; (** Initial transition *) 22 | m_body: (State.t * Transition.t list) list; (** Transitions, indexed by source state *) 23 | } 24 | 25 | val make: Fsm.t -> t 26 | (** [make f] builds a sequential model from FSM [f]. The FSM is first type-checked. *) 27 | -------------------------------------------------------------------------------- /src/lib/guard.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Transition guards} *) 14 | 15 | type t = Expr.t 16 | [@@deriving show {with_path=false}, yojson] 17 | (** The type of guards associated to transitions. 18 | Guards are just boolean expressions. *) 19 | 20 | (** {2 Printing} *) 21 | 22 | val to_string: Expr.t -> string 23 | 24 | (** {2 Simulation} *) 25 | 26 | exception Illegal_guard_expr of Expr.t 27 | 28 | val eval: Expr.env -> Expr.t -> bool 29 | (** [eval env e] evaluates guard expression [e] in environment [env], returning 30 | the corresponding boolean value. 31 | Raises [Illegal_guard_expr] if the expression does not denote a boolean value. *) 32 | 33 | 34 | -------------------------------------------------------------------------------- /src/lib/transition.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type t = State.t * Guard.t list * Action.t list * State.t 14 | [@@deriving show {with_path=false}, yojson] 15 | 16 | let to_string (src,guards,actions,dst) = 17 | let s0 = src ^ " -> " ^ dst in 18 | let s1 = Misc.string_of_list ~f:Guard.to_string ~sep:"." guards in 19 | let s2 = Misc.string_of_list ~f:Action.to_string ~sep:"," actions in 20 | let s3 = match s1, s2 with 21 | | "", "" -> "" 22 | | s1, "" -> s1 23 | | s1, s2 -> s1 ^ "/" ^ s2 in 24 | match s3 with 25 | "" -> s0 26 | | _ -> s0 ^ " [" ^ s3 ^ "]" 27 | 28 | (* Simulation *) 29 | 30 | let is_fireable src env (src',guards,_,_) = 31 | src = src' 32 | && List.for_all (Guard.eval env) guards 33 | -------------------------------------------------------------------------------- /src/lib/vcd.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 VCD output} *) 14 | 15 | val write: fname:string -> fsm:Fsm.t -> Tevents.t list -> unit 16 | (** [write ~fname:file ~fsm:f evs] writes a representation of a list of timed events sets [evs], 17 | for FSM [f] in VCD (Value Change Dump) format in file [file]. *) 18 | 19 | val view: ?fname:string -> ?cmd:string -> fsm:Fsm.t -> Tevents.t list -> int 20 | (** [view m evs] views a simulation result for FSM [m] by first writing a [.vcd] file 21 | and then launching a VCD viewer application. The name of the output file and 22 | of the viewer application can be changed using the [fname] and [cmd] optional 23 | arguments. Returns the issued command exit status. *) 24 | -------------------------------------------------------------------------------- /src/lib/transition.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 FSM Transitions} *) 14 | 15 | type t = State.t * Guard.t list * Action.t list * State.t 16 | [@@deriving show {with_path=false}, yojson] 17 | (** [(src,guards,actions,dst)] means that the FSM will go from state [src] to state 18 | [dst] whenever all guards listed in [guards] evaluate to [true], performing, sequentially, 19 | all actions listed in [actions]. *) 20 | 21 | (** {2 Printers} *) 22 | 23 | val to_string: t -> string 24 | 25 | (** {2 Simulation} *) 26 | 27 | val is_fireable: State.t -> Expr.env -> t -> bool 28 | (** [is_fireable src env t] returns [true] iff transition [t] is fireable 29 | when the enclosing FSM is in state [state] and the inputs and local variables 30 | have values recorded in environment [env]. *) 31 | -------------------------------------------------------------------------------- /src/lib/fsm_lexer.mll: -------------------------------------------------------------------------------- 1 | { 2 | open Fsm_parser 3 | 4 | exception Illegal_character of int * string 5 | 6 | (* The table of keywords *) 7 | 8 | let keyword_table = [ 9 | "name", NAME; 10 | "states", STATES; 11 | "vars", VARS; 12 | "trans", TRANS; 13 | "itrans", ITRANS; 14 | "inputs", INPUTS; 15 | "outputs", OUTPUTS; 16 | "int", TYINT; 17 | "uint", TYUINT; 18 | "bool", TYBOOL; 19 | "when", WHEN; 20 | "with", WITH; 21 | "and", AND; 22 | ] 23 | } 24 | 25 | rule main = parse 26 | | [' ' '\t'] + 27 | { main lexbuf } 28 | | ['\010' '\013' ] 29 | { Lexing.new_line lexbuf; main lexbuf } 30 | | ['a'-'z' ] ( ['A'-'Z' 'a'-'z' '0'-'9' '_' ] ) * 31 | { let s = Lexing.lexeme lexbuf in 32 | try List.assoc s keyword_table 33 | with Not_found -> LID s } 34 | | ['A'-'Z' 'a'-'z' ] ( ['A'-'Z' 'a'-'z' '0'-'9' '_' ] ) * 35 | { UID (Lexing.lexeme lexbuf) } 36 | | ['0'-'9']+ 37 | { INT (int_of_string(Lexing.lexeme lexbuf)) } 38 | | "'0'" { BOOL false } 39 | | "'1'" { BOOL true } 40 | | ";" { SEMICOLON } 41 | | "(" { LPAREN } 42 | | ")" { RPAREN } 43 | | "," { COMMA } 44 | | "->" { ARROW } 45 | | ":" { COLON } 46 | | ".." { DOTDOT } 47 | | "=" { EQUAL } 48 | | ":=" { COLEQ } 49 | | "!=" { NOTEQUAL } 50 | | '>' { GT } 51 | | '<' { LT } 52 | | ">=" { GTE } 53 | | "<=" { LTE } 54 | | '+' { PLUS } 55 | | '-' { MINUS } 56 | | '*' { TIMES } 57 | | '/' { DIV } 58 | (* | '&' { LAND } 59 | * | "||" { LOR } 60 | * | '^' { LXOR } 61 | * | ">>" { SHR } 62 | * | "<<" { SHL } *) 63 | | eof { EOF } 64 | | _ { raise (Illegal_character (Lexing.lexeme_start lexbuf, Lexing.lexeme lexbuf)) } 65 | -------------------------------------------------------------------------------- /src/lib/tevents.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type t = Event.t list Clock.clocked 14 | [@@deriving show {with_path=false}] 15 | 16 | let merge2 l1 l2 = 17 | let rec h l1 l2 = match l1, l2 with 18 | [], [] -> [] 19 | | l1, [] -> l1 20 | | [], l2 -> l2 21 | | (t1,evs1)::ss1, (t2,evs2)::ss2 -> 22 | if t1=t2 then (t1,evs1@evs2) :: h ss1 ss2 23 | else if t1 [] 34 | | l::ls -> List.fold_left merge2 l ls 35 | 36 | let changes id vcs = List.map (fun (t,v) -> (t, [id,v])) vcs 37 | 38 | let to_string (t,evs) = Printf.sprintf "t=%d: %s" t (Misc.string_of_list ~f:Event.to_string ~sep:"," evs) 39 | -------------------------------------------------------------------------------- /src/lib/dot.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Dot output} *) 14 | 15 | type options = { 16 | mutable node_shape: string; 17 | mutable node_style: string; 18 | mutable rankdir: string; 19 | mutable layout: string; 20 | mutable mindist: float 21 | } 22 | 23 | val default_options: options 24 | 25 | val write: string -> ?options:options -> Fsm.t -> unit 26 | (** [write fname m] writes a [.dot] representation of FSM [m] in file [fname]. 27 | Rendering can be modified with the [options] optional argument. *) 28 | 29 | val view: ?options:options -> ?fname:string -> ?cmd:string -> Fsm.t -> int 30 | (** [view m] views FSM [m] by first writing its [.dot] representation in file 31 | and then launching a DOT viewer application. The name of the output file and 32 | of the viewer application can be changed using the [fname] and [cmd] optional 33 | arguments. Returns the issued command exit status. *) 34 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__State/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__State (fsml.Fsml__State)

Module Fsml__State

FSM states

type t = string
val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val to_yojson : t -> Yojson.Safe.t
val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or
-------------------------------------------------------------------------------- /examples/ex2/vhdl/tb.vhd: -------------------------------------------------------------------------------- 1 | library ieee; 2 | use ieee.std_logic_1164.all; 3 | use ieee.numeric_std.all; 4 | 5 | entity tb is 6 | end entity; 7 | 8 | architecture struct of tb is 9 | 10 | component gensig is 11 | port( 12 | start: in std_logic; 13 | s: out std_logic; 14 | clk: in std_logic; 15 | rst: in std_logic 16 | ); 17 | end component; 18 | 19 | signal clk: std_logic; 20 | signal rst: std_logic; 21 | signal start: std_logic; 22 | signal s: std_logic; 23 | 24 | begin 25 | 26 | inp_start: process 27 | type t_vc is record date: time; val: std_logic; end record; 28 | type t_vcs is array ( 0 to 2 ) of t_vc; 29 | constant vcs : t_vcs := ( (0 ns, '0'), (15 ns, '1'), (25 ns, '0') ); 30 | variable i : natural := 0; 31 | variable t : time := 0 ns; 32 | begin 33 | for i in 0 to 2 loop 34 | wait for vcs(i).date-t; 35 | Start <= vcs(i).val; 36 | t := vcs(i).date; 37 | end loop; 38 | wait; 39 | end process; 40 | 41 | inp_clk: process 42 | type t_periodic is record period: time; t1: time; t2: time; end record; 43 | constant periodic : t_periodic := ( 10 ns, 10 ns, 100 ns ); 44 | variable t : time := 0 ns; 45 | begin 46 | clk <= '0'; 47 | wait for periodic.t1; 48 | t := t + periodic.t1; 49 | while ( t < periodic.t2 ) loop 50 | clk <= '1'; 51 | wait for periodic.period/2; 52 | clk <= '0'; 53 | wait for periodic.period/2; 54 | t := t + periodic.period; 55 | end loop; 56 | wait; 57 | end process; 58 | 59 | inp_reset: process 60 | begin 61 | rst <= '1'; 62 | wait for 1 ns; 63 | rst <= '0'; 64 | wait for 100 ns; 65 | wait; 66 | end process; 67 | 68 | UUT: gensig port map(start, s, clk, rst); 69 | 70 | end architecture; 71 | -------------------------------------------------------------------------------- /src/lib/valuation.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 A [valuation] is a collection of [(name,value)] associations} *) 14 | 15 | type name = string 16 | [@@deriving show {with_path=false}, yojson] 17 | 18 | type value = Expr.t 19 | [@@deriving show {with_path=false}, yojson] 20 | 21 | type t = (name * value) list (** Basic, public implementation here *) 22 | [@@deriving show {with_path=false}, yojson] 23 | 24 | val compare: t -> t -> int 25 | 26 | val to_string: t -> string 27 | 28 | exception Invalid_valuation of t 29 | 30 | val check: name list -> t -> unit 31 | (** [check names vs] checks whether [vs] is a "complete" valuation wrt. to [names]. {i i.e.} whether 32 | each variable listed in [names] has a valuation in [vs] and each variable listed in [vs] occurs in 33 | [names]. Raises {!Invalid_valuation} in case of failure. *) 34 | 35 | val empty: t 36 | 37 | exception Duplicate of name 38 | 39 | val add: name -> value -> t -> t 40 | 41 | val remove: name -> t -> t 42 | 43 | val mem: name -> t -> bool 44 | 45 | val assoc: name -> t -> value 46 | 47 | -------------------------------------------------------------------------------- /src/lib/seqmodel.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type t = { 14 | m_name: string; 15 | m_states: (string * Valuation.t) list; 16 | m_inps: (string * Types.t) list; 17 | m_outps: (string * Types.t) list; 18 | m_vars: (string * Types.t) list; 19 | m_init: State.t * Action.t list; 20 | m_body: (State.t * Transition.t list) list; (* Transitions, indexed by source state *) 21 | (* m_body = [case_1;...;case_n] 22 | means 23 | "while ( 1 ) { switch ( [state] ) { [case_1]; ...; [case_n] } }" *) 24 | } 25 | 26 | let make f = 27 | let f = Typing.type_check_fsm ~mono:true f in 28 | let open Fsm in 29 | let src_states ts = 30 | let rec scan acc ts = match ts with 31 | | [] -> List.rev acc 32 | | (src,_,_,_)::rest -> if List.mem src acc then scan acc rest else scan (src::acc) rest in 33 | scan [] ts in 34 | { m_name = f.id; 35 | m_states = f.states; 36 | m_inps = f.inps; 37 | m_outps = f.outps; 38 | m_vars = f.vars; 39 | m_init = f.itrans; 40 | m_body = List.map (fun s -> s, List.filter (fun (s',_,_,_) -> s=s') f.trans) (src_states f.trans) 41 | } 42 | 43 | -------------------------------------------------------------------------------- /docs/fsml/Fsml/State/index.html: -------------------------------------------------------------------------------- 1 | 2 | State (fsml.Fsml.State)

Module Fsml.State

FSM states

type t = string
val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val to_yojson : t -> Yojson.Safe.t
val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or
-------------------------------------------------------------------------------- /docs/fsml/Fsml__Fsm_lexer/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Fsm_lexer (fsml.Fsml__Fsm_lexer)

Module Fsml__Fsm_lexer

exception Illegal_character of int * string
val keyword_table : (string * Fsml.Fsm_parser.token) list
val __ocaml_lex_tables : Stdlib.Lexing.lex_tables
val main : Stdlib.Lexing.lexbuf -> Fsml.Fsm_parser.token
val __ocaml_lex_main_rec : Stdlib.Lexing.lexbuf -> int -> Fsml.Fsm_parser.token
-------------------------------------------------------------------------------- /docs/fsml/Fsml/Fsm_lexer/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsm_lexer (fsml.Fsml.Fsm_lexer)

Module Fsml.Fsm_lexer

exception Illegal_character of int * string
val keyword_table : (string * Fsm_parser.token) list
val __ocaml_lex_tables : Stdlib.Lexing.lex_tables
val main : Stdlib.Lexing.lexbuf -> Fsm_parser.token
val __ocaml_lex_main_rec : Stdlib.Lexing.lexbuf -> int -> Fsm_parser.token
-------------------------------------------------------------------------------- /docs/fsml/Fsml__Event/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Event (fsml.Fsml__Event)

Module Fsml__Event

Simulation events

type t = Fsml.Expr.ident * Fsml.Expr.e_val

(id,v) means that input, output or local variable id take value v

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string

Printer

val to_string : t -> string
-------------------------------------------------------------------------------- /docs/fsml/Fsml__Vcd/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Vcd (fsml.Fsml__Vcd)

Module Fsml__Vcd

VCD output

val write : fname:string -> fsm:Fsml.Fsm.t -> Fsml.Tevents.t list -> unit

write ~fname:file ~fsm:f evs writes a representation of a list of timed events sets evs, for FSM f in VCD (Value Change Dump) format in file file.

val view : ?⁠fname:string -> ?⁠cmd:string -> fsm:Fsml.Fsm.t -> Fsml.Tevents.t list -> int

view m evs views a simulation result for FSM m by first writing a .vcd file and then launching a VCD viewer application. The name of the output file and of the viewer application can be changed using the fname and cmd optional arguments. Returns the issued command exit status.

-------------------------------------------------------------------------------- /src/lib/valuation.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type name = string 14 | [@@deriving show {with_path=false}, yojson] 15 | 16 | type value = Expr.t 17 | [@@deriving show {with_path=false}, yojson] 18 | 19 | type t = (name * value) list (* A simple implementation using association list *) 20 | [@@deriving show {with_path=false}, yojson] 21 | 22 | let empty = [] 23 | 24 | exception Duplicate of name 25 | 26 | let add n v vs = if List.mem_assoc n vs then raise (Duplicate n) else (n,v)::vs 27 | 28 | let remove n vs = List.remove_assoc n vs 29 | 30 | let mem n vs = List.mem_assoc n vs 31 | 32 | let assoc n vs = List.assoc n vs 33 | 34 | let compare vs1 vs2 = 35 | let module S = Set.Make (struct type t = name * value let compare = Stdlib.compare end) in 36 | S.compare (S.of_list vs1) (S.of_list vs2) 37 | 38 | let to_string vs = Misc.string_of_list ~f:(function (n,v) -> n ^ "=" ^ Expr.to_string v) ~sep:"," vs 39 | 40 | exception Invalid_valuation of t 41 | 42 | let names_of v = List.map fst v 43 | 44 | let check names v = 45 | let module S = Set.Make (struct type t = string let compare = Stdlib.compare end) in 46 | if not (S.equal (S.of_list names) (S.of_list (names_of v))) then raise (Invalid_valuation v) 47 | 48 | -------------------------------------------------------------------------------- /docs/fsml/Fsml/Event/index.html: -------------------------------------------------------------------------------- 1 | 2 | Event (fsml.Fsml.Event)

Module Fsml.Event

Simulation events

type t = Expr.ident * Expr.e_val

(id,v) means that input, output or local variable id take value v

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string

Printer

val to_string : t -> string
-------------------------------------------------------------------------------- /src/lib/tevents.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Timed event sets} *) 14 | 15 | type t = Event.t list Clock.clocked 16 | [@@deriving show {with_path=false}] 17 | (** A timed event set (TES) is a list of events occuring at a given clock cycle. 18 | Example [4, [x:=1,y:=1]] means that both [x] and [y] take value [1] at clock cycle 4. 19 | TES are used by simulator both to represent {i input stimuli} and {i output events} *) 20 | 21 | module Ops : sig 22 | val ( @@@ ): t list -> t list -> t list 23 | (** The [@@@] infix operator merges two sequences of TES wrt. clock cycles. 24 | Ex: [[(0,[x:=1]); (2;[x:=0])] @@@ [(1,[y:=1]); (2;y:=0)]] gives [[(0,[x:=1]); (1,[y:=1]); (2,[x:=0;y:=0])]]. *) 25 | end 26 | 27 | val merge: t list list -> t list 28 | (** [merge [st1; ...: stn]] merges n sequences of TES wrt. clock cycles. 29 | In other words, [merge [l1; l2; ...; ln]] is [l1 @@@ l2 @@@ ... @@@ ln]. *) 30 | 31 | (** {2 Wrappers} *) 32 | 33 | val changes: string -> (Expr.e_val Clock.clocked) list -> t list 34 | (** [changes name vcs] builds a list of TES from a list [vcs] of {i value changes} related to signal 35 | [name], a value change being a pair of the clk cycle and a value. 36 | Ex: [changes "x" [0,Int 1; 2,Int 0]] is [[0,[x:=1]; 2,[x:=0]]]. *) 37 | 38 | (** {2 Printing} *) 39 | 40 | val to_string: t -> string 41 | -------------------------------------------------------------------------------- /docs/fsml/Fsml/Vcd/index.html: -------------------------------------------------------------------------------- 1 | 2 | Vcd (fsml.Fsml.Vcd)

Module Fsml.Vcd

VCD output

val write : fname:string -> fsm:Fsm.t -> Tevents.t list -> unit

write ~fname:file ~fsm:f evs writes a representation of a list of timed events sets evs, for FSM f in VCD (Value Change Dump) format in file file.

val view : ?⁠fname:string -> ?⁠cmd:string -> fsm:Fsm.t -> Tevents.t list -> int

view m evs views a simulation result for FSM m by first writing a .vcd file and then launching a VCD viewer application. The name of the output file and of the viewer application can be changed using the fname and cmd optional arguments. Returns the issued command exit status.

-------------------------------------------------------------------------------- /src/lib/c.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 C backend} *) 14 | 15 | type config = { 16 | mutable state_var: string; (** Name of variable storing the current state (default: [state]) *) 17 | mutable incl_file: string (** Name of the support include file (default: [fsml.h] *) 18 | } 19 | 20 | val cfg: config 21 | 22 | exception Error of string * string (* where, message *) 23 | 24 | val write: ?dir:string -> prefix:string -> Fsm.t -> unit 25 | (** [write prefix m] writes in files [prefix.h] and [prefix.c] a representation of FSM [m] as a C function. 26 | This function has prototype [void fsm_xxx(ctx_t *ctx)], where [xxx] is [m.m_id] and [ctx_t] is the 27 | type of a structure recording the value of inputs and outputs of the machine. 28 | Each call to the [fsm_xxx] function will correspond to one execution step of the machine: it 29 | first looks for a fireable transition (depending on the values of the inputs read in the context [ctx] 30 | and of the local variables) and, if found, performs the action associated to this transition (updating 31 | the value of outputs and local variables) and updates the current state. 32 | The generated files are written in the current working directory unless a target directory is specified 33 | with the [dir] argument. If the target directory does not exist, an attempt is made to create it. *) 34 | -------------------------------------------------------------------------------- /src/lib/parse.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | exception Error of int * int * string * string (* Line, column, token, message *) 14 | 15 | (* let report_error s lexbuf msg = 16 | * let open Lexing in 17 | * let loc_line offset l = 18 | * let m = Bytes.make (String.length l) '.' in 19 | * Bytes.set m offset '^'; 20 | * Bytes.to_string m in 21 | * let pos = lexbuf.lex_curr_p in 22 | * let l = 23 | * try s |> String.split_on_char '\n' |> Fun.flip List.nth (pos.pos_lnum-1) 24 | * with Invalid_argument _ -> s in 25 | * let offset = pos.pos_cnum - pos.pos_bol - 1 in 26 | * Printf.printf "%s\n%s^\n%s" l (loc_line offset l) msg *) 27 | 28 | let error lexbuf msg = 29 | let open Lexing in 30 | let pos = lexbuf.lex_curr_p in 31 | raise (Error( pos.pos_lnum-1, pos.pos_cnum-pos.pos_bol-1, Lexing.lexeme lexbuf, msg)) 32 | 33 | let parse f s = 34 | let lexbuf = Lexing.from_string s in 35 | try 36 | lexbuf |> f Fsm_lexer.main 37 | with 38 | | Fsm_lexer.Illegal_character (_, _) -> error lexbuf "Illegal character" 39 | | Fsm_parser.Error -> error lexbuf "Syntax error" 40 | 41 | let guard = parse Fsm_parser.guard_top 42 | let guards = parse Fsm_parser.guards_top 43 | let action = parse Fsm_parser.action_top 44 | let actions = parse Fsm_parser.actions_top 45 | let transition = parse Fsm_parser.transition_top 46 | let stimuli = parse Fsm_parser.stimuli 47 | let fsm = parse Fsm_parser.fsm 48 | -------------------------------------------------------------------------------- /src/lib/ppxs.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | open Ppxlib 14 | open Fsml 15 | 16 | let expand parser_name parser_fn ~loc ~path:_ (s:_) = 17 | let _ = 18 | try parser_fn s 19 | with Parse.Error (line,_,tok,msg) -> 20 | if line = -1 then (* No location *) 21 | Location.raise_errorf ~loc "%s " msg 22 | else 23 | Location.raise_errorf ~loc "%s at line %d near token \"%s\"" msg (loc.loc_start.pos_lnum+line) tok in 24 | let f = Ast_builder.Default.evar ~loc parser_name in 25 | let e = Ast_builder.Default.estring ~loc s in 26 | [%expr [%e f] [%e e]] 27 | 28 | let mk_ext ext_name parser_name parser_fn = 29 | Extension.declare 30 | ext_name 31 | Extension.Context.expression 32 | Ast_pattern.(single_expr_payload (estring __)) 33 | (expand parser_name parser_fn) 34 | 35 | let () = Ppxlib.Driver.register_transformation "fsm_guard" ~extensions:[mk_ext "fsm_guard" "Parse.guard" Parse.guard] 36 | let () = Ppxlib.Driver.register_transformation "fsm_guards" ~extensions:[mk_ext "fsm_guards" "Parse.guards" Parse.guards] 37 | let () = Ppxlib.Driver.register_transformation "fsm_action" ~extensions:[mk_ext "fsm_action" "Parse.action" Parse.action] 38 | let () = Ppxlib.Driver.register_transformation "fsm_actions" ~extensions:[mk_ext "fsm_actions" "Parse.actions" Parse.actions] 39 | let () = Ppxlib.Driver.register_transformation "fsm_trans" ~extensions:[mk_ext "fsm_trans" "Parse.transition" Parse.transition] 40 | let () = Ppxlib.Driver.register_transformation "fsm" ~extensions:[mk_ext "fsm" "Parse.fsm" Parse.fsm] 41 | let () = Ppxlib.Driver.register_transformation "fsm_stim" ~extensions:[mk_ext "fsm_stim" "Parse.stimuli" Parse.stimuli] 42 | -------------------------------------------------------------------------------- /src/lib/misc.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | let string_of_list ~f ~sep l = 14 | let rec h = function 15 | [] -> "" 16 | | [x] -> f x 17 | | x::xs -> f x ^ sep ^ h xs in 18 | h l 19 | 20 | let iter_fst f l = 21 | ignore (List.fold_left (fun z x -> f z x; false) true l) 22 | 23 | let list_make ~f ~lo ~hi = 24 | let rec mk i = 25 | if i <= hi then f i :: mk (i+1) 26 | else [] in 27 | mk lo 28 | 29 | 30 | let flat_map f l = List.concat (List.map f l) 31 | 32 | let cart_prod l1 l2 = 33 | let prod p l1 l2 = flat_map (function e1 -> List.map (p e1) l2) l1 in 34 | prod (fun x y -> x,y) l1 l2 35 | 36 | let list_parse ~parse_item ~sep s = 37 | let rec parse s = 38 | match Stream.peek s with 39 | | Some _ -> 40 | let e = parse_item s in 41 | let es = parse_aux s in 42 | e::es 43 | | None -> 44 | [] 45 | and parse_aux s = 46 | match Stream.peek s with 47 | | Some (Genlex.Kwd sep') when sep=sep' -> 48 | Stream.junk s; 49 | parse s 50 | | _ -> 51 | [] in 52 | parse s 53 | 54 | let string_of_opt f = function 55 | | None -> "" 56 | | Some x -> f x 57 | 58 | let rec bit_size n = if n=0 then 0 else 1 + bit_size (n/2) 59 | 60 | let rec pow2 k = if k = 0 then 1 else 2 * pow2 (k-1) 61 | 62 | let quote_string s = "\"" ^ s ^ "\"" 63 | 64 | let check_dir path = 65 | if not (Sys.file_exists path && Sys.is_directory path) 66 | then Unix.mkdir path 0o777 67 | 68 | let spaces n = String.make n ' ' 69 | 70 | let replace_assoc k v l = 71 | let rec scan = function 72 | [] -> [] 73 | | (k',v')::rest -> if k = k' then (k,v)::scan rest else (k',v')::scan rest in 74 | scan l 75 | -------------------------------------------------------------------------------- /src/lib/typing.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** Typing *) 14 | 15 | exception Typing_error of string * string * string (** what, where, msg *) 16 | 17 | type env = (string * Types.typ_scheme) list 18 | (** Typing environment *) 19 | 20 | val type_check_fsm: ?mono:bool -> Fsm.t -> Fsm.t 21 | (** [type_check_fsm f] type checks FSM [f], raising [!Typing_error] when 22 | appropriate. Setting the optional [mono] argument also checks that all types occuring in the 23 | FSM definitions are monomorphic. This is required, for instance to generate C or VHDL code. *) 24 | 25 | val type_check_fsm_guard: ?mono:bool -> ?with_clk:bool -> Fsm.t -> Guard.t -> Guard.t 26 | (** [type_check_fsm_guard f e] type checks guard expression [e] in the context of FSM [f]. 27 | As for [type_check_fsm], setting the [mono] optional argument also checks that all involved 28 | types are monomorphic. 29 | Setting the [with_clk] optional argument adds a variable named [clk] (with type [int]) to 30 | the typing environment. *) 31 | 32 | val type_check_fsm_action: ?mono:bool -> Fsm.t -> Action.t -> Action.t 33 | (** [type_check_fsm_action f a] type checks action [a] in the context of FSM [f]. 34 | As for [type_check_fsm], passing the [mono] optional argument also checks that all involved 35 | types are monomorphic. *) 36 | 37 | val type_check_stimuli: Fsm.t -> Tevents.t list -> Tevents.t list 38 | (** [type_check_stimuli f s] type checks a sequence [s] of stimuli for a FSM [f], raising [!Typing_error] when 39 | appropriate (for example if an event [e] refers to a non-existent input of [f] or if the type of value asssociated 40 | to [e] does not match the type of the corresponding input in [f]. *) 41 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Clock/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Clock (fsml.Fsml__Clock)

Module Fsml__Clock

Clock

type clk = int

Clock cycle counter

val pp_clk : Ppx_deriving_runtime.Format.formatter -> clk -> Ppx_deriving_runtime.unit
val show_clk : clk -> Ppx_deriving_runtime.string
type 'a clocked = clk * 'a
val pp_clocked : (Ppx_deriving_runtime.Format.formatter -> 'a -> Ppx_deriving_runtime.unit) -> Ppx_deriving_runtime.Format.formatter -> 'a clocked -> Ppx_deriving_runtime.unit
val show_clocked : (Ppx_deriving_runtime.Format.formatter -> 'a -> Ppx_deriving_runtime.unit) -> 'a clocked -> Ppx_deriving_runtime.string
-------------------------------------------------------------------------------- /src/lib/expr.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Simple (int) expressions for FSMs} *) 14 | 15 | type ident = string 16 | [@@deriving show {with_path=false}, yojson] 17 | (** The type of identifiers occuring in expressions *) 18 | 19 | type t = { 20 | e_desc: e_desc; 21 | mutable e_typ: Types.t; 22 | } 23 | [@@deriving show {with_path=false}, yojson] 24 | 25 | and e_desc = 26 | EInt of int 27 | | EBool of bool 28 | | EVar of ident 29 | | EBinop of string * t * t 30 | [@@deriving show {with_path=false}, yojson] 31 | 32 | type value = { 33 | mutable v_desc: e_val; 34 | mutable v_typ: Types.t; 35 | } 36 | [@@deriving show {with_path=false}] 37 | 38 | and e_val = 39 | | Int of int 40 | | Bool of bool 41 | | Prim of (e_val list -> e_val) 42 | | Unknown 43 | | Enum of string (** This is a hack to allow tracing of state transitions *) 44 | [@@deriving show {with_path=false}] 45 | 46 | val of_value: e_val -> t 47 | 48 | val is_const: t -> bool 49 | 50 | val is_var_test: string -> t -> bool 51 | 52 | (** {2 Builders} *) 53 | 54 | val mk_bool_expr: e_desc -> t 55 | val mk_int_expr: e_desc -> t 56 | 57 | (** {2 Evaluation} *) 58 | 59 | type env = (ident * e_val) list 60 | [@@deriving show] 61 | (** Evaluation environment *) 62 | 63 | (** {2 Printing} *) 64 | 65 | val to_string: t -> string 66 | 67 | val string_of_value: e_val -> string 68 | 69 | (** {2 Simulation} *) 70 | 71 | val lookup_env: env -> ident -> e_val 72 | val update_env: env -> ident * e_val -> env 73 | 74 | exception Unbound_id of ident 75 | exception Unknown_id of ident 76 | exception Illegal_expr of t 77 | exception Illegal_value of e_val 78 | 79 | val eval: env -> t -> e_val 80 | 81 | val bool_val: e_val -> bool 82 | val int_val: e_val -> int 83 | -------------------------------------------------------------------------------- /examples/ex3/vhdl/tb.vhd: -------------------------------------------------------------------------------- 1 | library ieee; 2 | use ieee.std_logic_1164.all; 3 | use ieee.numeric_std.all; 4 | 5 | -- Note : this file was, mostly, automatically generated using 6 | -- the RFSM compiler (https://github.com/jserot/rfsm) 7 | 8 | entity tb is 9 | end entity; 10 | 11 | architecture struct of tb is 12 | 13 | component pgcd is 14 | port( 15 | start: in std_logic; 16 | m: in integer range 0 to 255; 17 | n: in integer range 0 to 255; 18 | rdy: out std_logic; 19 | r: out integer range 0 to 255; 20 | clk: in std_logic; 21 | rst: in std_logic 22 | ); 23 | end component; 24 | 25 | signal clk: std_logic; 26 | signal rst: std_logic; 27 | signal start: std_logic; 28 | signal m: integer range 0 to 255; 29 | signal n: integer range 0 to 255; 30 | signal rdy: std_logic; 31 | signal r: integer range 0 to 255; 32 | 33 | begin 34 | 35 | inp_data: process 36 | type t_vc is record date: time; val1: integer; val2: integer; end record; 37 | type t_vcs is array ( 0 to 0 ) of t_vc; 38 | constant vcs : t_vcs := ( others => (0 ns, 24, 36) ); 39 | variable i : natural := 0; 40 | variable t : time := 0 ns; 41 | begin 42 | for i in 0 to 0 loop 43 | wait for vcs(i).date-t; 44 | m <= vcs(i).val1; 45 | n <= vcs(i).val2; 46 | t := vcs(i).date; 47 | end loop; 48 | wait; 49 | end process; 50 | 51 | inp_start: process 52 | type t_vc is record date: time; val: std_logic; end record; 53 | type t_vcs is array ( 0 to 2 ) of t_vc; 54 | constant vcs : t_vcs := ( (0 ns, '0'), (15 ns, '1'), (35 ns, '0') ); 55 | variable i : natural := 0; 56 | variable t : time := 0 ns; 57 | begin 58 | for i in 0 to 2 loop 59 | wait for vcs(i).date-t; 60 | Start <= vcs(i).val; 61 | t := vcs(i).date; 62 | end loop; 63 | wait; 64 | end process; 65 | 66 | inp_clk: process 67 | type t_periodic is record period: time; t1: time; t2: time; end record; 68 | constant periodic : t_periodic := ( 10 ns, 10 ns, 100 ns ); 69 | variable t : time := 0 ns; 70 | begin 71 | clk <= '0'; 72 | wait for periodic.t1; 73 | t := t + periodic.t1; 74 | while ( t < periodic.t2 ) loop 75 | clk <= '1'; 76 | wait for periodic.period/2; 77 | clk <= '0'; 78 | wait for periodic.period/2; 79 | t := t + periodic.period; 80 | end loop; 81 | wait; 82 | end process; 83 | 84 | inp_reset: process 85 | begin 86 | rst <= '1'; 87 | wait for 1 ns; 88 | rst <= '0'; 89 | wait for 100 ns; 90 | wait; 91 | end process; 92 | 93 | UUT: pgcd port map(start, m, n, rdy, r, clk, rst); 94 | 95 | end architecture; 96 | -------------------------------------------------------------------------------- /src/lib/vhdl.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 VHDL backend} *) 14 | 15 | type config = { 16 | mutable state_var: string; (** Name of signal storing the current state (default: [state]) *) 17 | mutable reset_sig: string; (** Name of the asynchronous reset input (default: [rst]) *) 18 | mutable clk_sig: string; (** Name of the clock input (default: [clk]) *) 19 | mutable use_numeric_std: bool; (** Encode integers as VHDL [Signed] or [Unsigned] (default: false) *) 20 | mutable act_sem: act_semantics; (** Use sequential or synchronous semantics for actions (default: sequential) *) 21 | } 22 | 23 | and act_semantics = 24 | | Sequential 25 | | Synchronous 26 | (** Interpretation of actions associated to transitions. 27 | With a a [Sequential] interpretation, the sequence [x:=x+1,y:=x], with [x=1], will lead to [x=2,y=2]. 28 | With a a [Synchronous] interpretation, the same sequence will lead to [x=2,y=1]. 29 | The default behavior is set to [Sequential] in order to make OCaml, C and VHDL behaviors observationaly equivalent. 30 | Synchronous behavior is implemented (and can be selected) but potentially breaks this equivalence because it 31 | is not (yet) implemented at the OCaml and C level. *) 32 | 33 | val cfg : config 34 | 35 | exception Error of string * string (* where, message *) 36 | 37 | val write: ?dir:string -> prefix:string -> Fsm.t -> unit 38 | (** [write prefix m] writes in file [prefix.vhd] a representation of FSM [m] as a VHDL entity and architecture. 39 | The architecture is a synchronous FSM, with a [clk] signal and a asynchronous, active high, [rst] signal. 40 | Transitions are performed on the rising edge of the [clk] signal. 41 | The generated file is written in the current working directory unless a target directory is specified 42 | with the [dir] argument. If the target directory does not exist, an attempt is made to create it. *) 43 | -------------------------------------------------------------------------------- /docs/fsml/Fsml/Clock/index.html: -------------------------------------------------------------------------------- 1 | 2 | Clock (fsml.Fsml.Clock)

Module Fsml.Clock

Clock

type clk = int

Clock cycle counter

val pp_clk : Ppx_deriving_runtime.Format.formatter -> clk -> Ppx_deriving_runtime.unit
val show_clk : clk -> Ppx_deriving_runtime.string
type 'a clocked = clk * 'a
val pp_clocked : (Ppx_deriving_runtime.Format.formatter -> 'a -> Ppx_deriving_runtime.unit) -> Ppx_deriving_runtime.Format.formatter -> 'a clocked -> Ppx_deriving_runtime.unit
val show_clocked : (Ppx_deriving_runtime.Format.formatter -> 'a -> Ppx_deriving_runtime.unit) -> 'a clocked -> Ppx_deriving_runtime.string
-------------------------------------------------------------------------------- /src/lib/types.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** Types *) 14 | 15 | type t = 16 | | TyInt of sign attr * size attr * range attr 17 | | TyBool 18 | | TyArrow of t * t (** Internal use only *) 19 | | TyProduct of t list (** Internal use only *) 20 | | TyVar of t var (** Internal use only *) 21 | [@@deriving show {with_path=false}, yojson] 22 | 23 | and 'a attr = 24 | | Const of 'a 25 | | Var of ('a attr) var 26 | [@@deriving show {with_path=false}, yojson] 27 | 28 | and 'a var = 29 | { stamp: string; 30 | mutable value: 'a value } 31 | [@@deriving show {with_path=false}, yojson] 32 | 33 | and 'a value = 34 | | Unknown 35 | | Known of 'a 36 | [@@deriving show {with_path=false}, yojson] 37 | 38 | and sign = Signed | Unsigned [@@deriving show {with_path=false}, yojson] 39 | and size = int [@@deriving show {with_path=false}, yojson] 40 | and range = { lo: int; hi: int } [@@deriving show {with_path=false}, yojson] 41 | 42 | type typ_scheme = 43 | { ts_params: ts_params; 44 | ts_body: t } 45 | [@@deriving show {with_path=false}, yojson] 46 | 47 | and ts_params = { 48 | tp_typ: (t var) list; 49 | tp_sign: ((sign attr) var) list; 50 | tp_size: ((size attr) var) list; 51 | tp_range: ((range attr) var) list; 52 | } 53 | 54 | (** {2 Builders} *) 55 | 56 | val new_type_var: unit -> t var 57 | (** [new_type_var ()] returns a fresh type variable *) 58 | 59 | val new_attr_var: unit -> ('a attr) var 60 | (** [new_attr_var ()] returns a fresh type attribute variable *) 61 | 62 | val type_int: unit -> t 63 | 64 | val trivial_scheme: t -> typ_scheme 65 | 66 | (** {2 Unification} *) 67 | 68 | exception TypeConflict of t * t 69 | exception TypeCircularity of t * t 70 | 71 | val unify: t -> t -> unit 72 | 73 | val type_instance: typ_scheme -> t 74 | 75 | val real_type: t -> t 76 | val real_attr: 'a attr -> 'a attr 77 | 78 | exception Polymorphic of t 79 | 80 | val mono_type: t -> t 81 | (** Remove all type variables from type representation [t]. Raises [!Polymorphic] if 82 | [t] contains unresolved type variables. *) 83 | 84 | (** {2 Printing} *) 85 | 86 | val to_string: t -> string 87 | -------------------------------------------------------------------------------- /src/lib/simul.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Simulation} *) 14 | 15 | type ctx = { 16 | state: State.t; 17 | env: Expr.env 18 | } 19 | [@@deriving show] 20 | (** A context is the dynamic view of a FSM. It records its current state 21 | and, in [env], the value of its inputs, outputs and local variables. *) 22 | 23 | (** {2 Simulation functions} *) 24 | 25 | val step: ctx -> Fsm.t -> Event.t list * ctx 26 | (** [step ctx m] performs a single simulation step, within context [ctx] of FSM [m]. 27 | The first fireable transition is selected according to the current state and 28 | value of the inputs and local variables. The actions associated to this transition 29 | are executed and both the state and context are updated accordingly. 30 | If no fireable transition is found, the context is left unchanged. 31 | Returns a list timed output events and the updated context. *) 32 | 33 | val run: 34 | ?ctx:ctx -> 35 | ?stop_when:Guard.t list -> 36 | ?stop_after:Clock.clk -> 37 | ?trace:bool -> 38 | stim:Tevents.t list -> 39 | Fsm.t -> 40 | Tevents.t list * (ctx Clock.clocked) list 41 | (** [run ctx stim m] performs a multi-step simulation of FSM [m] starting from 42 | context [ctx] and applying a ordered sequence of stimuli listed in [stim], producing 43 | a sequence of timed event sets and, if the optional argument [trace] is set, the corresponding sequence of contexts. 44 | FSM [m] is first type-checked. 45 | If the initial context [ctx] is not given it is built by triggering the initial transition 46 | of [m] and gathers its inputs, local variables and outputs. 47 | Passing an initial context may be used to start a simulation from a given state obtained from 48 | a previous simulation. 49 | If a list of guards is given as optional argument [stop_when], then simulation stops as soon all of these guards 50 | of the these guards becomes true. The guards may include relational operators on the special variable 51 | [clk], refering to the current simulation step. Ex: [-stop_when [%fsm_guard {|rdy=1|}]]; 52 | If a clock cycle count [n] is given as optional argument [stop_after], then simulation stops after exactly 53 | [n] steps (so that [-stop_after n] is actually a shorthand for [-stop_when "clk=n"]). *) 54 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Seqmodel/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Seqmodel (fsml.Fsml__Seqmodel)

Module Fsml__Seqmodel

Sequential model (used by C and VHDL backends)

type t = {
m_name : string;
m_states : (string * Fsml.Valuation.t) list;
m_inps : (string * Fsml.Types.t) list;
m_outps : (string * Fsml.Types.t) list;
m_vars : (string * Fsml.Types.t) list;
m_init : Fsml.State.t * Fsml.Action.t list;

Initial transition

m_body : (Fsml.State.t * Fsml.Transition.t list) list;

Transitions, indexed by source state

}
val make : Fsml.Fsm.t -> t

make f builds a sequential model from FSM f. The FSM is first type-checked.

-------------------------------------------------------------------------------- /docs/fsml/Fsml__C/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__C (fsml.Fsml__C)

Module Fsml__C

C backend

type config = {
mutable state_var : string;

Name of variable storing the current state (default: state)

mutable incl_file : string;

Name of the support include file (default: fsml.h

}
val cfg : config
exception Error of string * string
val write : ?⁠dir:string -> prefix:string -> Fsml.Fsm.t -> unit

write prefix m writes in files prefix.h and prefix.c a representation of FSM m as a C function. This function has prototype void fsm_xxx(ctx_t *ctx), where xxx is m.m_id and ctx_t is the type of a structure recording the value of inputs and outputs of the machine. Each call to the fsm_xxx function will correspond to one execution step of the machine: it first looks for a fireable transition (depending on the values of the inputs read in the context ctx and of the local variables) and, if found, performs the action associated to this transition (updating the value of outputs and local variables) and updates the current state. The generated files are written in the current working directory unless a target directory is specified with the dir argument. If the target directory does not exist, an attempt is made to create it.

-------------------------------------------------------------------------------- /src/lib/builtins.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | open Types 14 | 15 | let type_arithm () = 16 | let sg = Types.new_attr_var () in 17 | let sz = Types.new_attr_var () in 18 | let rg = Types.new_attr_var () in 19 | { ts_params={tp_typ=[]; tp_sign=[sg]; tp_size=[]; tp_range=[rg]}; 20 | ts_body=TyArrow 21 | (TyProduct 22 | [TyInt (Var sg, Var sz, Var rg); TyInt (Var sg, Var sz, Var rg)], 23 | TyInt (Var sg, Var sz, Var rg)) } 24 | 25 | let type_compar () = 26 | let t = Types.new_type_var () in 27 | { ts_params={tp_typ=[t]; tp_sign=[]; tp_size=[]; tp_range=[]}; 28 | ts_body=TyArrow (TyProduct [TyVar t; TyVar t], TyBool) } 29 | 30 | exception Unknown_value 31 | 32 | let encode_int n = 33 | Expr.Int n 34 | let decode_int = function 35 | | Expr.Int n -> n 36 | | Expr.Unknown -> raise Unknown_value 37 | | _ -> failwith "Builtins.decode_int" (* should not happen *) 38 | let encode_bool b = 39 | Expr.Bool b 40 | (* let decode_bool = function 41 | * | Expr.Bool b -> b 42 | * | Expr.Unknown -> raise Unknown_value 43 | * | _ -> failwith "Builtins.decode bool" (\* should not happen *\) *) 44 | 45 | let prim2 encode op decode = 46 | function 47 | | [v1;v2] -> 48 | begin 49 | try encode (op (decode v1) (decode v2)) 50 | with Unknown_value -> Expr.Unknown 51 | end 52 | | _ -> failwith "Builtins.prim2" 53 | 54 | let cprim2 op = 55 | let decode v = v in 56 | function 57 | | [v1;v2] -> 58 | begin 59 | try encode_bool (op (decode v1) (decode v2)) 60 | with Unknown_value -> Expr.Unknown 61 | end 62 | | _ -> failwith "Builtins.cprim2" 63 | 64 | let prims = [ 65 | "+", (type_arithm (), prim2 encode_int ( + ) decode_int); 66 | "-", (type_arithm (), prim2 encode_int ( - ) decode_int); 67 | "*", (type_arithm (), prim2 encode_int ( * ) decode_int); 68 | "/", (type_arithm (), prim2 encode_int ( / ) decode_int); 69 | "=", (type_compar () , cprim2 ( = )); 70 | "!=", (type_compar (), cprim2 ( <> )); 71 | "<", (type_compar (), cprim2 ( < )); 72 | ">", (type_compar (), cprim2 ( > )); 73 | "<=", (type_compar (), cprim2 ( <= )); 74 | ">=", (type_compar (), cprim2 ( >= )) 75 | ] 76 | 77 | let typing_env = List.map (fun (id, (ty, _)) -> id, ty) prims 78 | 79 | let eval_env = List.map (fun (id, (_, f)) -> id, Expr.Prim f) prims 80 | -------------------------------------------------------------------------------- /docs/fsml/Fsml/Seqmodel/index.html: -------------------------------------------------------------------------------- 1 | 2 | Seqmodel (fsml.Fsml.Seqmodel)

Module Fsml.Seqmodel

Sequential model (used by C and VHDL backends)

type t = {
m_name : string;
m_states : (string * Valuation.t) list;
m_inps : (string * Types.t) list;
m_outps : (string * Types.t) list;
m_vars : (string * Types.t) list;
m_init : State.t * Action.t list;

Initial transition

m_body : (State.t * Transition.t list) list;

Transitions, indexed by source state

}
val make : Fsm.t -> t

make f builds a sequential model from FSM f. The FSM is first type-checked.

-------------------------------------------------------------------------------- /docs/fsml/Fsml__Action/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Action (fsml.Fsml__Action)

Module Fsml__Action

Transition actions

type t =
| Assign of Fsml.Expr.ident * Fsml.Expr.t

The type of actions associated to FSM transitions

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val to_yojson : t -> Yojson.Safe.t
val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or

Printer

val to_string : t -> string

Simulation

val perform : Fsml.Expr.env -> t -> Fsml.Event.t list

perform env a performs action a in the context of environment env returning a list of resulting events.

-------------------------------------------------------------------------------- /docs/fsml/Fsml/C/index.html: -------------------------------------------------------------------------------- 1 | 2 | C (fsml.Fsml.C)

Module Fsml.C

C backend

type config = {
mutable state_var : string;

Name of variable storing the current state (default: state)

mutable incl_file : string;

Name of the support include file (default: fsml.h

}
val cfg : config
exception Error of string * string
val write : ?⁠dir:string -> prefix:string -> Fsm.t -> unit

write prefix m writes in files prefix.h and prefix.c a representation of FSM m as a C function. This function has prototype void fsm_xxx(ctx_t *ctx), where xxx is m.m_id and ctx_t is the type of a structure recording the value of inputs and outputs of the machine. Each call to the fsm_xxx function will correspond to one execution step of the machine: it first looks for a fireable transition (depending on the values of the inputs read in the context ctx and of the local variables) and, if found, performs the action associated to this transition (updating the value of outputs and local variables) and updates the current state. The generated files are written in the current working directory unless a target directory is specified with the dir argument. If the target directory does not exist, an attempt is made to create it.

-------------------------------------------------------------------------------- /docs/fsml/Fsml__Dot/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Dot (fsml.Fsml__Dot)

Module Fsml__Dot

Dot output

type options = {
mutable node_shape : string;
mutable node_style : string;
mutable rankdir : string;
mutable layout : string;
mutable mindist : float;
}
val default_options : options
val write : string -> ?⁠options:options -> Fsml.Fsm.t -> unit

write fname m writes a .dot representation of FSM m in file fname. Rendering can be modified with the options optional argument.

val view : ?⁠options:options -> ?⁠fname:string -> ?⁠cmd:string -> Fsml.Fsm.t -> int

view m views FSM m by first writing its .dot representation in file and then launching a DOT viewer application. The name of the output file and of the viewer application can be changed using the fname and cmd optional arguments. Returns the issued command exit status.

-------------------------------------------------------------------------------- /docs/fsml/Fsml__Guard/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Guard (fsml.Fsml__Guard)

Module Fsml__Guard

Transition guards

type t = Fsml.Expr.t

The type of guards associated to transitions. Guards are just boolean expressions.

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val to_yojson : t -> Yojson.Safe.t
val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or

Printing

val to_string : Fsml.Expr.t -> string

Simulation

exception Illegal_guard_expr of Fsml.Expr.t
val eval : Fsml.Expr.env -> Fsml.Expr.t -> bool

eval env e evaluates guard expression e in environment env, returning the corresponding boolean value. Raises Illegal_guard_expr if the expression does not denote a boolean value.

-------------------------------------------------------------------------------- /docs/fsml/Fsml/Action/index.html: -------------------------------------------------------------------------------- 1 | 2 | Action (fsml.Fsml.Action)

Module Fsml.Action

Transition actions

type t =
| Assign of Expr.ident * Expr.t

The type of actions associated to FSM transitions

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val to_yojson : t -> Yojson.Safe.t
val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or

Printer

val to_string : t -> string

Simulation

val perform : Expr.env -> t -> Event.t list

perform env a performs action a in the context of environment env returning a list of resulting events.

-------------------------------------------------------------------------------- /docs/fsml/Fsml/Guard/index.html: -------------------------------------------------------------------------------- 1 | 2 | Guard (fsml.Fsml.Guard)

Module Fsml.Guard

Transition guards

type t = Expr.t

The type of guards associated to transitions. Guards are just boolean expressions.

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val to_yojson : t -> Yojson.Safe.t
val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or

Printing

val to_string : Expr.t -> string

Simulation

exception Illegal_guard_expr of Expr.t
val eval : Expr.env -> Expr.t -> bool

eval env e evaluates guard expression e in environment env, returning the corresponding boolean value. Raises Illegal_guard_expr if the expression does not denote a boolean value.

-------------------------------------------------------------------------------- /docs/fsml/Fsml/Dot/index.html: -------------------------------------------------------------------------------- 1 | 2 | Dot (fsml.Fsml.Dot)

Module Fsml.Dot

Dot output

type options = {
mutable node_shape : string;
mutable node_style : string;
mutable rankdir : string;
mutable layout : string;
mutable mindist : float;
}
val default_options : options
val write : string -> ?⁠options:options -> Fsm.t -> unit

write fname m writes a .dot representation of FSM m in file fname. Rendering can be modified with the options optional argument.

val view : ?⁠options:options -> ?⁠fname:string -> ?⁠cmd:string -> Fsm.t -> int

view m views FSM m by first writing its .dot representation in file and then launching a DOT viewer application. The name of the output file and of the viewer application can be changed using the fname and cmd optional arguments. Returns the issued command exit status.

-------------------------------------------------------------------------------- /docs/fsml/Fsml__Transition/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Transition (fsml.Fsml__Transition)

Module Fsml__Transition

FSM Transitions

type t = Fsml.State.t * Fsml.Guard.t list * Fsml.Action.t list * Fsml.State.t

(src,guards,actions,dst) means that the FSM will go from state src to state dst whenever all guards listed in guards evaluate to true, performing, sequentially, all actions listed in actions.

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val to_yojson : t -> Yojson.Safe.t
val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or

Printers

val to_string : t -> string

Simulation

val is_fireable : Fsml.State.t -> Fsml.Expr.env -> t -> bool

is_fireable src env t returns true iff transition t is fireable when the enclosing FSM is in state state and the inputs and local variables have values recorded in environment env.

-------------------------------------------------------------------------------- /docs/fsml/Fsml/Transition/index.html: -------------------------------------------------------------------------------- 1 | 2 | Transition (fsml.Fsml.Transition)

Module Fsml.Transition

FSM Transitions

type t = State.t * Guard.t list * Action.t list * State.t

(src,guards,actions,dst) means that the FSM will go from state src to state dst whenever all guards listed in guards evaluate to true, performing, sequentially, all actions listed in actions.

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val to_yojson : t -> Yojson.Safe.t
val of_yojson : Yojson.Safe.t -> t Ppx_deriving_yojson_runtime.error_or

Printers

val to_string : t -> string

Simulation

val is_fireable : State.t -> Expr.env -> t -> bool

is_fireable src env t returns true iff transition t is fireable when the enclosing FSM is in state state and the inputs and local variables have values recorded in environment env.

-------------------------------------------------------------------------------- /docs/fsml/Fsml__Tevents/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Tevents (fsml.Fsml__Tevents)

Module Fsml__Tevents

Timed event sets

type t = Fsml.Event.t list Fsml.Clock.clocked

A timed event set (TES) is a list of events occuring at a given clock cycle. Example 4, [x:=1,y:=1] means that both x and y take value 1 at clock cycle 4. TES are used by simulator both to represent input stimuli and output events

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
module Ops : sig ... end
val merge : t list list -> t list

merge [st1; ...: stn] merges n sequences of TES wrt. clock cycles. In other words, merge [l1; l2; ...; ln] is l1 @@@ l2 @@@ ... @@@ ln.

Wrappers

val changes : string -> Fsml.Expr.e_val Fsml.Clock.clocked list -> t list

changes name vcs builds a list of TES from a list vcs of value changes related to signal name, a value change being a pair of the clk cycle and a value. Ex: changes "x" [0,Int 1; 2,Int 0] is [0,[x:=1]; 2,[x:=0]].

Printing

val to_string : t -> string
-------------------------------------------------------------------------------- /docs/fsml/Fsml/Tevents/index.html: -------------------------------------------------------------------------------- 1 | 2 | Tevents (fsml.Fsml.Tevents)

Module Fsml.Tevents

Timed event sets

type t = Event.t list Clock.clocked

A timed event set (TES) is a list of events occuring at a given clock cycle. Example 4, [x:=1,y:=1] means that both x and y take value 1 at clock cycle 4. TES are used by simulator both to represent input stimuli and output events

val pp : Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
module Ops : sig ... end
val merge : t list list -> t list

merge [st1; ...: stn] merges n sequences of TES wrt. clock cycles. In other words, merge [l1; l2; ...; ln] is l1 @@@ l2 @@@ ... @@@ ln.

Wrappers

val changes : string -> Expr.e_val Clock.clocked list -> t list

changes name vcs builds a list of TES from a list vcs of value changes related to signal name, a value change being a pair of the clk cycle and a value. Ex: changes "x" [0,Int 1; 2,Int 0] is [0,[x:=1]; 2,[x:=0]].

Printing

val to_string : t -> string
-------------------------------------------------------------------------------- /src/lib/simul.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | open Fsm 14 | 15 | type ctx = { 16 | state: State.t; 17 | env: Expr.env 18 | } 19 | [@@deriving show] 20 | 21 | let check_fsm m = Typing.type_check_fsm m 22 | let check_stimuli m st = Typing.type_check_stimuli m st 23 | 24 | let output_state_events m state = 25 | assert (List.mem_assoc state m.states); 26 | List.assoc state m.states |> List.map (fun (o,e) -> Action.Assign (o,e)) 27 | 28 | let step ctx m = 29 | match List.find_opt (Transition.is_fireable ctx.state (Builtins.eval_env @ ctx.env)) m.trans with 30 | | Some (src, _, acts, dst) -> 31 | let acts' = acts @ output_state_events m dst in 32 | let evs = List.concat @@ List.map (Action.perform (Builtins.eval_env @ ctx.env)) acts' in 33 | (if src <> dst then ("state",Expr.Enum dst)::evs else evs), 34 | { state = dst; 35 | env = List.fold_left Expr.update_env ctx.env evs } 36 | | None -> 37 | [], 38 | ctx 39 | 40 | let run ?ctx ?(stop_when=[]) ?(stop_after=0) ?(trace=false) ~stim m = 41 | let open Clock in 42 | let m = check_fsm m in 43 | let stim = check_stimuli m stim in 44 | let stop_conds = 45 | let open Expr in 46 | if stop_after > 0 then 47 | [mk_bool_expr (EBinop(">=", (mk_int_expr (EVar "clk")), (mk_int_expr (EInt stop_after))))] 48 | else 49 | List.map (Typing.type_check_fsm_guard ~with_clk:true m) stop_when in 50 | let eval_stop_conds clk ctx = 51 | let env' = Builtins.eval_env @ ctx.env @ ["clk", Expr.Int clk] in 52 | List.for_all (Guard.eval env') stop_conds in 53 | let trace_log = ref ([] : ctx clocked list) in 54 | let rec eval (clk, ctx, evs) stim = 55 | if eval_stop_conds clk ctx then List.rev evs, List.rev !trace_log (* Done ! *) 56 | else 57 | match stim with 58 | | (t,evs')::rest when t=clk -> 59 | let ctx' = { ctx with env = List.fold_left Expr.update_env ctx.env evs' } in 60 | let evs'', ctx'' = step ctx' m in 61 | if trace then trace_log := (t,ctx'')::!trace_log; 62 | let evs''' = 63 | begin match evs with 64 | | (t',es)::rest when t'=t -> (t',es@evs'')::rest 65 | | _ -> (t,evs'')::evs 66 | end in 67 | eval (clk+1, ctx'', evs''') rest 68 | | _ -> (* No applicable stimuli *) 69 | let evs', ctx' = step ctx m in 70 | if trace then trace_log := (clk,ctx')::!trace_log; 71 | eval (clk+1, ctx', (clk, evs')::evs) [] in 72 | let ctx, evs = match ctx, m.Fsm.itrans with 73 | | Some c, _ -> 74 | c, 75 | [] 76 | | None, (s0,acts0) -> 77 | let env0 = List.map (fun (id,_) -> id, Expr.Unknown) (m.inps @ m.outps @ m.vars) in 78 | let acts0' = acts0 @ output_state_events m s0 in 79 | let evs0 = List.concat @@ List.map (Action.perform (Builtins.eval_env @ env0)) acts0' in 80 | { state = s0; env = List.fold_left Expr.update_env env0 evs0 }, 81 | [0, ("state",Expr.Enum s0)::evs0] in 82 | if trace then trace_log := [0,ctx]; 83 | eval (0, ctx, evs) stim 84 | -------------------------------------------------------------------------------- /src/lib/expr.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** Fsm expressions *) 14 | 15 | type ident = string 16 | [@@deriving show {with_path=false}, yojson] 17 | 18 | type t = { 19 | e_desc: e_desc; 20 | mutable e_typ: Types.t; 21 | } 22 | [@@deriving show {with_path=false}, yojson] 23 | 24 | and e_desc = 25 | EInt of int 26 | | EBool of bool 27 | | EVar of ident 28 | | EBinop of string * t * t 29 | [@@deriving show {with_path=false}, yojson] 30 | 31 | type value = { 32 | mutable v_desc: e_val; 33 | mutable v_typ: Types.t; 34 | } 35 | [@@deriving show {with_path=false}] 36 | 37 | and e_val = 38 | | Int of int 39 | | Bool of bool 40 | | Prim of (e_val list -> e_val) 41 | | Unknown 42 | | Enum of string 43 | [@@deriving show {with_path=false}] 44 | 45 | let of_value v = match v with 46 | | Int v -> { e_desc=EInt v; e_typ=Types.type_int () } 47 | | Bool v -> { e_desc=EBool v; e_typ=Types.TyBool } 48 | | _ -> failwith "Expr.of_value" 49 | 50 | let is_const e = 51 | match e.e_desc with 52 | | EInt _ -> true 53 | | EBool _ -> true 54 | | _ -> false 55 | 56 | let is_var_test v e = 57 | match e.e_desc with 58 | | EBinop (op, {e_desc=EVar v'; _}, _) 59 | | EBinop (op, _, {e_desc=EVar v'; _}) -> 60 | v'=v && List.mem op ["="; "<"; ">"; "<="; ">=" ] 61 | | _ -> false 62 | 63 | let mk_bool_expr e = { e_desc = e; e_typ = Types.TyBool } 64 | let mk_int_expr e = { e_desc = e; e_typ = Types.type_int () } 65 | 66 | type env = (ident * e_val) list 67 | [@@deriving show] 68 | 69 | exception Unbound_id of ident 70 | exception Unknown_id of ident 71 | exception Illegal_expr of t 72 | exception Illegal_value of e_val 73 | 74 | let lookup_env env id = 75 | try 76 | match List.assoc id env with 77 | | Unknown -> raise (Unbound_id id) 78 | | v -> v 79 | with 80 | Not_found -> raise (Unknown_id id) 81 | 82 | let update_env env (k,v) = 83 | let rec scan = function 84 | | [] -> [] 85 | | (k',v')::rest -> if k=k' then (k, v)::rest else (k',v')::scan rest in 86 | scan env 87 | 88 | let rec eval : env -> t -> e_val = fun env exp -> 89 | match exp.e_desc with 90 | | EInt v -> Int v 91 | | EBool v -> Bool v 92 | | EVar id -> lookup_env env id 93 | | EBinop (op, e1, e2) -> 94 | begin match lookup_env env op, eval env e1, eval env e2 with 95 | | Prim f, v1, v2 -> f [v1;v2] 96 | | _, _, _ -> raise (Illegal_expr exp) 97 | end 98 | 99 | let rec to_string e = match e.e_desc with 100 | EInt c -> string_of_int c 101 | | EBool c -> if c then "'1'" else "'0'" 102 | | EVar n -> n 103 | | EBinop (op,e1,e2) -> to_string e1 ^ op ^ to_string e2 (* TODO : add parens *) 104 | 105 | let string_of_value v = match v with 106 | | Int c -> string_of_int c 107 | | Bool b -> if b then "'1'" else "'0'" 108 | | Prim _ -> "" 109 | | Unknown -> "" 110 | | Enum s -> s 111 | 112 | let bool_val v = match v with Bool v -> v | _ -> raise (Illegal_value v) 113 | let int_val v = match v with Int v -> v | _ -> raise (Illegal_value v) 114 | 115 | 116 | -------------------------------------------------------------------------------- /src/lib/fsm.mli: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | (** {1 Finite State Machines} *) 14 | 15 | type t = { 16 | id: string; (** Name *) 17 | states: (State.t * Valuation.t) list; 18 | inps: (string * Types.t) list; (** Inputs *) 19 | outps: (string * Types.t) list; (** Outputs *) 20 | vars: (string * Types.t) list; (** Local variables *) 21 | trans: Transition.t list; 22 | itrans: State.t * Action.t list; (** Initial transition *) 23 | } [@@deriving show {with_path=false}, yojson] 24 | (** The static description of a FSM *) 25 | 26 | (** {2 Transformation functions} *) 27 | 28 | exception Unknown_output of string 29 | 30 | val mealy_outps : ?outps:string list -> t -> t 31 | (** [mealy_outps os m] returns the FSM obtained by moving the assignation of outputs 32 | listed in [outps] from states to all incoming transitions. When the [outps] parameter is empty 33 | or omitted, the transformation is applied to all outputs occuring in each state. Raises [Unknown_output] if 34 | [outps] contains a symbol not declared as output. *) 35 | 36 | val moore_outps : ?outps:string list -> t -> t 37 | (** [moore_outps os m] is the dual function of {!mealy_outps}. For each output [o] listed in 38 | in [outps], whenever all transitions leading to a state [s] carry the same action [o:=v], it removes 39 | these actions and adds the assignation [o=v] to state [s]. The transformation is not applied if 40 | - the corresponding action does not occur on all transitions leading to state [s], 41 | - the value assigned to output [o] is not a constant, 42 | - not all actions assign the same value to [o] 43 | If [outps] is omitted ot empty, the transformation is applied to all outputs. Raises [Unknown_output] if 44 | [outps] contains a symbol not declared as output. *) 45 | 46 | exception Unknown_var of string 47 | exception Illegal_var_type of string * Types.t 48 | 49 | val defactorize: vars:(string * Expr.e_val) list -> ?cleaned:bool -> t -> t 50 | (** [defactorize vars m] returns an equivalent FSM obtained by removing variable listed in [vars] from [m] and 51 | introducing new states accordingly. 52 | The value attached to each variable is used to select the initial state in the defactorized FSM. 53 | Unreachable states are removed from the 54 | resulting automata unlesse the optional argument [clean] is set to false. Raises {!Unknown_var} if 55 | [vars] contains a symbol not declared as variable. Raises {!Illegal_var_type} if 56 | the specified var(s) do(es) not have an enumerable type (i.e. have not been declared with a range). *) 57 | 58 | val clean: t -> t 59 | (** [clean m] removes all unreachable states (and associated transitions) from m *) 60 | 61 | (** {2 JSON export/import} *) 62 | 63 | val to_string: t -> string 64 | (** [to_string m] writes a representation of FSM [m] as a string using the [Yojson] library. *) 65 | 66 | val from_string: string -> t 67 | (** [from_string s] returns the FSM [m] stored in string [s] using the [Yojson] library *) 68 | 69 | val to_file: fname:string -> t -> unit 70 | (** [to_file f] writes a representation of FSM [m] in file [f] using the [Yojson] library. *) 71 | 72 | val from_file: fname:string -> t 73 | (** [from_file f] returns the FSM [m] stored in file [f] using the [Yojson] library *) 74 | -------------------------------------------------------------------------------- /docs/fsml/Fsml/Typing/index.html: -------------------------------------------------------------------------------- 1 | 2 | Typing (fsml.Fsml.Typing)

Module Fsml.Typing

exception Typing_error of string * string * string

what, where, msg

type env = (string * Types.typ_scheme) list

Typing environment

val type_check_fsm : ?⁠mono:bool -> Fsm.t -> Fsm.t

type_check_fsm f type checks FSM f, raising !Typing_error when appropriate. Setting the optional mono argument also checks that all types occuring in the FSM definitions are monomorphic. This is required, for instance to generate C or VHDL code.

val type_check_fsm_guard : ?⁠mono:bool -> ?⁠with_clk:bool -> Fsm.t -> Guard.t -> Guard.t

type_check_fsm_guard f e type checks guard expression e in the context of FSM f. As for type_check_fsm, setting the mono optional argument also checks that all involved types are monomorphic. Setting the with_clk optional argument adds a variable named clk (with type int) to the typing environment.

val type_check_fsm_action : ?⁠mono:bool -> Fsm.t -> Action.t -> Action.t

type_check_fsm_action f a type checks action a in the context of FSM f. As for type_check_fsm, passing the mono optional argument also checks that all involved types are monomorphic.

val type_check_stimuli : Fsm.t -> Tevents.t list -> Tevents.t list

type_check_stimuli f s type checks a sequence s of stimuli for a FSM f, raising !Typing_error when appropriate (for example if an event e refers to a non-existent input of f or if the type of value asssociated to e does not match the type of the corresponding input in f.

-------------------------------------------------------------------------------- /src/lib/dot.ml: -------------------------------------------------------------------------------- 1 | (**********************************************************************) 2 | (* *) 3 | (* This file is part of the FSML library *) 4 | (* github.com/jserot/fsml *) 5 | (* *) 6 | (* Copyright (c) 2020-present, Jocelyn SEROT. All rights reserved. *) 7 | (* *) 8 | (* This source code is licensed under the license found in the *) 9 | (* LICENSE file in the root directory of this source tree. *) 10 | (* *) 11 | (**********************************************************************) 12 | 13 | type options = { 14 | mutable node_shape: string; 15 | mutable node_style: string; 16 | mutable rankdir: string; 17 | mutable layout: string; 18 | mutable mindist: float 19 | } 20 | 21 | let default_options = { 22 | node_shape = "circle"; 23 | node_style = "solid"; 24 | rankdir = "UD"; 25 | layout = "dot"; 26 | mindist = 1.0; 27 | } 28 | 29 | let output oc ?(options=default_options) m = 30 | let open Fsm in 31 | let ini_id = "_ini" in 32 | let dump_istate () = 33 | Printf.fprintf oc "%s [shape=point; label=\"\"; style = invis]\n" ini_id in 34 | let string_of_output_valuation vs = 35 | Misc.string_of_list ~f:(function (n,v) -> "\\n" ^ n ^ "=" ^ Expr.to_string v) ~sep:"" vs in 36 | let dump_state (id,oval) = 37 | Printf.fprintf oc "%s [label = \"%s%s\", shape = %s, style = %s]\n" 38 | id 39 | id 40 | (string_of_output_valuation oval) 41 | options.node_shape 42 | options.node_style in 43 | let string_of_guards guards = 44 | let ss = List.map Guard.to_string guards in 45 | let l = List.fold_left (fun m s -> max m (String.length s)) 0 ss in 46 | let s = Misc.string_of_list ~f:Fun.id ~sep:"\\n" ss in 47 | s, l in 48 | let string_of_actions actions = 49 | let ss = List.map Action.to_string actions in 50 | let l = List.fold_left (fun m s -> max m (String.length s)) 0 ss in 51 | let s = Misc.string_of_list ~f:Fun.id ~sep:"\\n" ss in 52 | s, l in 53 | let dump_itransition (dst,actions) = 54 | let s, l = string_of_actions actions in 55 | match s with 56 | | "" -> 57 | Printf.fprintf oc "%s->%s\n" ini_id dst 58 | | _ -> 59 | let sep = "\n" ^ String.make l '_' ^ "\n" in 60 | Printf.fprintf oc "%s->%s [label=\"%s%s\"]\n" ini_id dst sep s in 61 | let dump_transition (src,guards,actions,dst) = 62 | let s1, l1 = string_of_guards guards in 63 | let s2, l2 = string_of_actions actions in 64 | match s1, s2 with 65 | | "", "" -> 66 | Printf.fprintf oc "%s->%s\n" src dst 67 | | _, "" -> 68 | Printf.fprintf oc "%s->%s [label=\"%s\"]\n" src dst s1 69 | | "", _ -> 70 | let sep = "\n" ^ String.make l2 '_' ^ "\n" in 71 | Printf.fprintf oc "%s->%s [label=\"%s%s\"]\n" src dst sep s2 72 | | _, _ -> 73 | let sep = "\n" ^ String.make (max l1 l2) '_' ^ "\n" in 74 | Printf.fprintf oc "%s->%s [label=\"%s%s%s\"]\n" src dst s1 sep s2 in 75 | Printf.fprintf oc "digraph %s {\nlayout = %s;\nrankdir = %s;\nsize = \"8.5,11\";\nlabel = \"\"\n center = 1;\n nodesep = \"0.350000\"\n ranksep = \"0.400000\"\n fontsize = 14;\nmindist=\"%1.1f\"\n" 76 | m.id 77 | options.layout 78 | options.rankdir 79 | options.mindist; 80 | dump_istate (); 81 | List.iter dump_state m.states; 82 | dump_itransition m.itrans; 83 | List.iter dump_transition m.trans; 84 | Printf.fprintf oc "}\n" 85 | 86 | let write fname ?(options=default_options) m = 87 | let oc = open_out fname in 88 | output oc ~options m; 89 | Printf.printf "Wrote file %s\n" fname; 90 | close_out oc 91 | 92 | let view ?(options=default_options) ?(fname="") ?(cmd="open -a Graphviz") m = 93 | let fname = match fname with 94 | | "" -> "/tmp/" ^ m.Fsm.id ^ "_fsm.dot" 95 | | _ -> fname in 96 | let _ = write fname ~options m in 97 | Sys.command (cmd ^ " " ^ fname) 98 | -------------------------------------------------------------------------------- /docs/fsml/Fsml__Typing/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Typing (fsml.Fsml__Typing)

Module Fsml__Typing

Typing

exception Typing_error of string * string * string

what, where, msg

type env = (string * Fsml.Types.typ_scheme) list

Typing environment

val type_check_fsm : ?⁠mono:bool -> Fsml.Fsm.t -> Fsml.Fsm.t

type_check_fsm f type checks FSM f, raising !Typing_error when appropriate. Setting the optional mono argument also checks that all types occuring in the FSM definitions are monomorphic. This is required, for instance to generate C or VHDL code.

val type_check_fsm_guard : ?⁠mono:bool -> ?⁠with_clk:bool -> Fsml.Fsm.t -> Fsml.Guard.t -> Fsml.Guard.t

type_check_fsm_guard f e type checks guard expression e in the context of FSM f. As for type_check_fsm, setting the mono optional argument also checks that all involved types are monomorphic. Setting the with_clk optional argument adds a variable named clk (with type int) to the typing environment.

val type_check_fsm_action : ?⁠mono:bool -> Fsml.Fsm.t -> Fsml.Action.t -> Fsml.Action.t

type_check_fsm_action f a type checks action a in the context of FSM f. As for type_check_fsm, passing the mono optional argument also checks that all involved types are monomorphic.

val type_check_stimuli : Fsml.Fsm.t -> Fsml.Tevents.t list -> Fsml.Tevents.t list

type_check_stimuli f s type checks a sequence s of stimuli for a FSM f, raising !Typing_error when appropriate (for example if an event e refers to a non-existent input of f or if the type of value asssociated to e does not match the type of the corresponding input in f.

-------------------------------------------------------------------------------- /docs/fsml/Fsml__Misc/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Misc (fsml.Fsml__Misc)

Module Fsml__Misc

val string_of_list : f:('a -> string) -> sep:string -> 'a list -> string
val iter_fst : (bool -> 'a -> unit) -> 'a list -> unit
val list_make : f:(int -> 'a) -> lo:int -> hi:int -> 'a list
val flat_map : ('a -> 'b list) -> 'a list -> 'b list
val cart_prod : 'a list -> 'b list -> ('a * 'b) list
val list_parse : parse_item:(Stdlib.Genlex.token Stdlib.Stream.t -> 'a) -> sep:string -> Stdlib.Genlex.token Stdlib.Stream.t -> 'a list
val string_of_opt : ('a -> string) -> 'a option -> string
val bit_size : int -> int
val pow2 : int -> int
val quote_string : string -> string
val check_dir : string -> unit
val spaces : int -> string
val replace_assoc : 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list
-------------------------------------------------------------------------------- /docs/fsml/Fsml/Misc/index.html: -------------------------------------------------------------------------------- 1 | 2 | Misc (fsml.Fsml.Misc)

Module Fsml.Misc

val string_of_list : f:('a -> string) -> sep:string -> 'a list -> string
val iter_fst : (bool -> 'a -> unit) -> 'a list -> unit
val list_make : f:(int -> 'a) -> lo:int -> hi:int -> 'a list
val flat_map : ('a -> 'b list) -> 'a list -> 'b list
val cart_prod : 'a list -> 'b list -> ('a * 'b) list
val list_parse : parse_item:(Stdlib.Genlex.token Stdlib.Stream.t -> 'a) -> sep:string -> Stdlib.Genlex.token Stdlib.Stream.t -> 'a list
val string_of_opt : ('a -> string) -> 'a option -> string
val bit_size : int -> int
val pow2 : int -> int
val quote_string : string -> string
val check_dir : string -> unit
val spaces : int -> string
val replace_assoc : 'a -> 'b -> ('a * 'b) list -> ('a * 'b) list
-------------------------------------------------------------------------------- /docs/fsml/Fsml__Vhdl/index.html: -------------------------------------------------------------------------------- 1 | 2 | Fsml__Vhdl (fsml.Fsml__Vhdl)

Module Fsml__Vhdl

VHDL backend

type config = {
mutable state_var : string;

Name of signal storing the current state (default: state)

mutable reset_sig : string;

Name of the asynchronous reset input (default: rst)

mutable clk_sig : string;

Name of the clock input (default: clk)

mutable use_numeric_std : bool;

Encode integers as VHDL Signed or Unsigned (default: false)

mutable act_sem : act_semantics;

Use sequential or synchronous semantics for actions (default: sequential)

}
and act_semantics =
| Sequential
| Synchronous

Interpretation of actions associated to transitions. With a a Sequential interpretation, the sequence x:=x+1,y:=x, with x=1, will lead to x=2,y=2. With a a Synchronous interpretation, the same sequence will lead to x=2,y=1. The default behavior is set to Sequential in order to make OCaml, C and VHDL behaviors observationaly equivalent. Synchronous behavior is implemented (and can be selected) but potentially breaks this equivalence because it is not (yet) implemented at the OCaml and C level.

val cfg : config
exception Error of string * string
val write : ?⁠dir:string -> prefix:string -> Fsml.Fsm.t -> unit

write prefix m writes in file prefix.vhd a representation of FSM m as a VHDL entity and architecture. The architecture is a synchronous FSM, with a clk signal and a asynchronous, active high, rst signal. Transitions are performed on the rising edge of the clk signal. The generated file is written in the current working directory unless a target directory is specified with the dir argument. If the target directory does not exist, an attempt is made to create it.

-------------------------------------------------------------------------------- /docs/fsml/Fsml/Vhdl/index.html: -------------------------------------------------------------------------------- 1 | 2 | Vhdl (fsml.Fsml.Vhdl)

Module Fsml.Vhdl

VHDL backend

type config = {
mutable state_var : string;

Name of signal storing the current state (default: state)

mutable reset_sig : string;

Name of the asynchronous reset input (default: rst)

mutable clk_sig : string;

Name of the clock input (default: clk)

mutable use_numeric_std : bool;

Encode integers as VHDL Signed or Unsigned (default: false)

mutable act_sem : act_semantics;

Use sequential or synchronous semantics for actions (default: sequential)

}
and act_semantics =
| Sequential
| Synchronous

Interpretation of actions associated to transitions. With a a Sequential interpretation, the sequence x:=x+1,y:=x, with x=1, will lead to x=2,y=2. With a a Synchronous interpretation, the same sequence will lead to x=2,y=1. The default behavior is set to Sequential in order to make OCaml, C and VHDL behaviors observationaly equivalent. Synchronous behavior is implemented (and can be selected) but potentially breaks this equivalence because it is not (yet) implemented at the OCaml and C level.

val cfg : config
exception Error of string * string
val write : ?⁠dir:string -> prefix:string -> Fsm.t -> unit

write prefix m writes in file prefix.vhd a representation of FSM m as a VHDL entity and architecture. The architecture is a synchronous FSM, with a clk signal and a asynchronous, active high, rst signal. Transitions are performed on the rising edge of the clk signal. The generated file is written in the current working directory unless a target directory is specified with the dir argument. If the target directory does not exist, an attempt is made to create it.

--------------------------------------------------------------------------------