Jonathan Graveline pushed to branch graveline at Stefan / Typer

Commits: cf4448de by Jonathan Graveline at 2018-08-20T21:58:13Z Macro `Tuple` returning a type

Comment for `Test_file` in pervasive.typer

- - - - -

2 changed files:

- btl/pervasive.typer - btl/tuple.typer

Changes:

===================================== btl/pervasive.typer ===================================== @@ -563,6 +563,8 @@ _<-_ = tuple-lib.assign-tuple; %% creation (e.g. `tup = (x,y,z)`) _,_ = tuple-lib.make-tuple;

+Tuple = tuple-lib.tuple-type; + %% macro `case` for a little more complex pattern matching case_ = let lib = load_ "btl/case.typer" in lib.case-macro;

@@ -582,15 +584,27 @@ _|_ = let lib = load_ "btl/polyfun.typer" in lib._|_; %% It's hard to do a primitive which execute test file %% because of circular dependency...

+%% +%% A macro using `load` for testing purpose +%% +%% takes a file name (String) as argument +%% return variable named `exec-test` from the loaded file +%% +%% `exec-test` should be a command doing unit tests +%% for other purpose than that just use `load` directly! +%% Test_file = macro (lambda args -> let

+ %% return an empty command on error ret = Sexp_node (Sexp_symbol "IO_return") (cons (Sexp_symbol "unit") nil);

+%% Expecting a String and nothing else in IO_return (Sexp_dispatch (List_nth 0 args Sexp_error) (lambda _ _ -> ret) (lambda _ -> ret) + %% `load_` is a special form and takes a Sexp rather than a real `String` (lambda s -> quote (let lib = load_ (uquote (Sexp_string s)); in lib.exec-test)) (lambda _ -> ret) (lambda _ -> ret)

===================================== btl/tuple.typer ===================================== @@ -147,22 +147,24 @@ make-tuple-impl values = let mf2 value nth = Sexp_node (Sexp_symbol "_:=_") (cons nth (cons value nil));

in do { - %% rval <- gen-vars values; - %% args <- gen-vars rval; args <- gen-vars values; + names <- IO_return (gen-tuple-names values); - ctor <- gensym (); + fun <- IO_return (Sexp_node (Sexp_symbol "lambda_->_") (cons (Sexp_node (List_nth 0 args Sexp_error) (List_tail args)) (cons - (Sexp_node (Sexp_symbol "typecons") (cons (ctor) + (Sexp_node (Sexp_symbol "typecons") (cons (Sexp_symbol "Tuple") (cons (Sexp_node (Sexp_symbol "cons") (List_map2 mf1 names args)) nil))) nil)) ); + call-fun <- IO_return (Sexp_node fun (gen-deduce values)); + tuple <- IO_return (Sexp_node (Sexp_symbol "##datacons") (cons call-fun (cons (Sexp_symbol "cons") nil))); + affect <- IO_return (Sexp_node tuple (List_map2 mf2 values names)); - %% IO_return (wrap-vars values rval affect); + IO_return affect; };

@@ -171,3 +173,19 @@ make-tuple = macro (lambda args -> do { r <- IO_return r; IO_return r; }); + +tuple-type = macro (lambda args -> let + + mf : Sexp -> Sexp -> Sexp; + mf n t = Sexp_node (Sexp_symbol "_::_") + (cons n (cons t nil)); + +in do { + names <- IO_return (gen-tuple-names args); + + r <- IO_return (Sexp_node (Sexp_symbol "typecons") (cons + (Sexp_symbol "Tuple") (cons (Sexp_node (Sexp_symbol "cons") + (List_map2 mf names args)) nil))); + + IO_return r; +});

View it on GitLab: https://gitlab.com/monnier/typer/commit/cf4448de28d77e6539e0200bf763c45c1c15...