Jonathan Graveline pushed to branch graveline at Stefan / Typer

Commits: 7e8cd430 by Jonathan Graveline at 2018-05-25T03:34:45Z do macro, first draft - - - - -

1 changed file:

- + samples/do.typer

Changes:

===================================== samples/do.typer ===================================== --- /dev/null +++ b/samples/do.typer @@ -0,0 +1,138 @@ +% +% +% +% Here's an example : +% `` +% code = action +% (newline) (tab) (a <- return "Hello world") +% (b <- return "!") (print a) (print b) +% (newline) (newline); +% `` +% `print` take a `IO String` as `a` and `b` are in the above example. +% +% You can replace `action` by `do` to execute it at the end of the statement +% or call `do` on `code` later like this : +% `` +% do code; +% `` +% `action` may take `action` +% `do` may take `action` +% `do` can't take `do` +% + +nop = Sexp_node (Sexp_symbol "IO_return") (cons (Sexp_symbol "unit") nil); + +no-var = Sexp_symbol "_"; +assign = Sexp_symbol "<-"; + +ferr = (lambda _ -> Sexp_error); +ffollow = (lambda x y -> x); + +get-sym : Sexp -> Sexp; +get-sym sexp = let + + kno-var = (lambda _ -> no-var); + + return = (lambda v -> IO_return v); + + in Sexp_dispatch sexp + + ( lambda s ss -> if_then_else_ (Sexp_eq (List_nth 0 ss Sexp_error) assign) + (s) + (no-var) + ) + + %% If there's no assign there should be an IO op + kno-var kno-var kno-var + kno-var kno-var; + +get-op : Sexp -> Sexp; +get-op sexp = let + + follow = ffollow sexp; + + helper = (lambda sexp -> Sexp_dispatch sexp + + ( lambda s ss -> if_then_else_ (Sexp_eq (List_nth 0 ss Sexp_error) assign) + (Sexp_node (List_nth 1 ss Sexp_error) (List_tail (List_tail ss))) + (Sexp_node s ss) + ) + + follow follow follow follow follow + ); + +in (helper sexp); + +unit-wrap : Sexp -> Sexp; +unit-wrap sexp = Sexp_node (Sexp_symbol "lambda_->_") (cons (Sexp_symbol "_") (cons sexp nil)); + +%% (lambda a-sym -> [next fun]) a-op +%% (lambda a-sym -> ((lambda b-sym -> [next fun]) b-op)) a-op +%% this way a-sym is defined within b-op and so on + +set-fun : List Sexp -> Sexp; +set-fun args = let + + helper : List Sexp -> Sexp; + helper args = case args + | cons s ss => (let + + sym = get-sym s; + + op = get-op s; + + % function + in Sexp_node (Sexp_node (Sexp_symbol "lambda_->_") + + % arg + (cons sym + + % body + (cons (Sexp_node (Sexp_symbol "IO_bind") (cons sym (cons (unit-wrap (helper ss)) nil))) nil))) + + % call + (cons op nil) + ) + + | nil => nop; + +in helper args; + +% Serie of action that will be executed at the end +% you can use `<-` to affect something useful in subsequent arguments `(...)` + +do = macro (lambda args -> + Sexp_node (Sexp_node (Sexp_symbol "IO_run") (cons (set-fun args) nil)) (cons (Sexp_symbol "unit") nil) +); + +% `action` create a serie of IO but do not execute it + +action = macro (lambda args -> + (set-fun args) +); + +% Next are just function and constant. +% We can define much more. + +print_ str = (File_write (File_stdout ()) str); + +newline_ = IO_return "\n"; + +tab_ = IO_return "\t"; + +return v = IO_return v; + +print v = IO_bind v print_; + +newline = print newline_; + +tab = print tab_; + +%flt2str : IO Float -> IO String; + +%flt2str flt = IO_bind flt (lambda v -> IO_return (Float->String v)); + +HelloWorld = do (h <- action + (newline) (tab) (a <- return "Hello world") + (b <- return "!") (print a) (print b) + (newline) (newline));

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