Jonathan Graveline pushed to branch graveline at Stefan / Typer

Commits:

1 changed file:

Changes:

  • samples/do.typer
    1
    -%
    
    2
    -% 
    
    3
    -%
    
    4
    -% Here's an example :
    
    5
    -% ``
    
    6
    -%   fun = action (
    
    7
    -%     newline;
    
    8
    -%     tab;
    
    9
    -%     a <- return "Hello world";
    
    10
    -%     b <- return "!";
    
    11
    -%     print a;
    
    12
    -%     print b;
    
    13
    -%     newline;
    
    14
    -%     newline;
    
    15
    -%     return 0;
    
    16
    -%   );
    
    17
    -% ``
    
    18
    -% `print` take a `String` as `a` and `b` are bind by macro.
    
    19
    -%
    
    20
    -% `action` may take `action`
    
    21
    -%
    
    22
    -% (Change : var are now binded, now using ; to separate command)
    
    23
    -%
    
    24
    -
    
    25
    -no-var = Sexp_symbol "_";
    
    26
    -assign = Sexp_symbol "<-";
    
    1
    +%%%
    
    2
    +%%% Macro : action
    
    3
    +%%%
    
    4
    +
    
    5
    +%%
    
    6
    +%% Here's an example :
    
    7
    +%%
    
    8
    +%%    fun = action (
    
    9
    +%%      str <- return "\n\tHello world\n\n";
    
    10
    +%%      print str;
    
    11
    +%%    );
    
    12
    +%%
    
    13
    +%% str is bind by macro,
    
    14
    +%%
    
    15
    +%% fun is a command,
    
    16
    +%%
    
    17
    +%% action may contain action because it returns a command.
    
    18
    +%%
    
    27 19
     
    
    28
    -ferr = (lambda _ -> Sexp_error);
    
    29
    -ffollow = (lambda x y -> x);
    
    20
    +assign = Sexp_symbol "<-";
    
    30 21
     
    
    31 22
     get-sym : Sexp -> Sexp;
    
    32 23
     get-sym sexp = let
    
    33 24
     
    
    34
    -  kno-var = (lambda _ -> no-var);
    
    25
    +  dflt-sym = (lambda _ -> Sexp_symbol "_");
    
    35 26
     
    
    36 27
       in Sexp_dispatch sexp
    
    37 28
     
    
    38 29
       ( lambda s ss -> if_then_else_ (Sexp_eq (List_nth 0 ss Sexp_error) assign)
    
    39 30
         (s)
    
    40
    -    (no-var)
    
    31
    +    (dflt-sym ())
    
    41 32
       )
    
    42 33
       
    
    43
    -  %% If there's no assign there should be an IO op
    
    44
    -  kno-var kno-var kno-var 
    
    45
    -  kno-var kno-var;
    
    34
    +  dflt-sym dflt-sym dflt-sym 
    
    35
    +  dflt-sym dflt-sym; % there must be a command
    
    46 36
     
    
    47
    -get-op : Sexp -> Sexp -> Sexp;
    
    48
    -get-op lsym sexp = let
    
    37
    +get-op : Sexp -> Sexp;
    
    38
    +get-op sexp = let
    
    49 39
     
    
    50
    -  follow = ffollow sexp;
    
    40
    +  as-is = lambda _ -> sexp;
    
    51 41
     
    
    52 42
       helper = (lambda sexp -> Sexp_dispatch sexp
    
    53 43
     
    
    ... ... @@ -56,7 +46,7 @@ get-op lsym sexp = let
    56 46
           (Sexp_node s ss)
    
    57 47
         )
    
    58 48
       
    
    59
    -    follow follow follow follow follow
    
    49
    +    as-is as-is as-is as-is as-is
    
    60 50
       );
    
    61 51
       
    
    62 52
       op = (helper sexp);
    
    ... ... @@ -66,26 +56,29 @@ in if_then_else_ (Sexp_eq op (Sexp_symbol "")) Sexp_error op;
    66 56
     get-decl : List Sexp -> List Sexp;
    
    67 57
     get-decl args = let
    
    68 58
     
    
    69
    -  ferr = lambda _ -> cons Sexp_error nil;
    
    59
    +  err = lambda _ -> cons Sexp_error nil;
    
    70 60
     
    
    71 61
     in Sexp_dispatch (List_nth 0 args Sexp_error)
    
    72 62
     
    
    73 63
       (lambda s ss -> if_then_else_ 
    
    74 64
         (Sexp_eq (Sexp_symbol "_;_") s)
    
    75 65
         
    
    76
    -    % return declarations
    
    77
    -    (ss)
    
    66
    +    (ss) % return declarations
    
    78 67
         
    
    79
    -    % else assume there's only one declaration
    
    80
    -    (cons (Sexp_node s ss) nil)
    
    68
    +    (cons (Sexp_node s ss) nil) % assuming there's only one declaration
    
    81 69
       )
    
    82 70
       (lambda s -> cons (Sexp_symbol s) nil)
    
    83
    -  ferr ferr ferr ferr;
    
    84
    -
    
    85
    -%% IO_bind a-op (lambda a-sym -> [next fun])
    
    86
    -%% IO_bind a-op (lambda a-sym -> (IO_bind b-op (lambda b-sym -> [next fun])))
    
    71
    +  err err err err;
    
    72
    +
    
    73
    +%%
    
    74
    +%% The idea of the macro is :
    
    75
    +%% 
    
    76
    +%%    IO_bind a-op (lambda a-sym -> [next command or return a-sym])
    
    77
    +%%    IO_bind a-op (lambda a-sym -> (IO_bind b-op (lambda b-sym -> [next command or return a-sym])))
    
    78
    +%%
    
    87 79
     %% this way a-sym is defined within b-op and so on
    
    88 80
     %% a-sym is now just `a` and not `IO a`
    
    81
    +%%
    
    89 82
     
    
    90 83
     set-fun : List Sexp -> Sexp;
    
    91 84
     set-fun args = let 
    
    ... ... @@ -96,16 +89,11 @@ set-fun args = let
    96 89
           
    
    97 90
             sym = get-sym s;
    
    98 91
           
    
    99
    -        op = get-op lsym s;
    
    100
    -    
    
    101
    -        % Simpler to directly bind command to variable
    
    102
    -        % also return last variable so you may `return` something
    
    92
    +        op = get-op s;
    
    103 93
             
    
    104 94
             in (case ss
    
    105
    -          | cons _ _ => Sexp_node (Sexp_symbol "IO_bind") 
    
    106
    -            (cons (op)
    
    107
    -            (cons (Sexp_node (Sexp_symbol "lambda_->_") (cons sym (cons (helper sym ss) nil))) nil)
    
    108
    -            )
    
    95
    +          | cons _ _ => Sexp_node (Sexp_symbol "IO_bind") (cons (op)
    
    96
    +            (cons (Sexp_node (Sexp_symbol "lambda_->_") (cons sym (cons (helper sym ss) nil))) nil))
    
    109 97
               | nil => Sexp_node (Sexp_symbol "IO_return") (cons lsym nil)
    
    110 98
             )
    
    111 99
           )
    
    ... ... @@ -114,41 +102,38 @@ set-fun args = let
    114 102
     
    
    115 103
     in helper (Sexp_symbol "()") args;
    
    116 104
     
    
    117
    -% Serie of action
    
    118
    -% you can use `<-` to affect something useful in subsequent arguments `(...)`
    
    105
    +%% Serie of command
    
    119 106
     
    
    120 107
     action = macro (lambda args ->
    
    121 108
       (set-fun (get-decl args))
    
    122 109
     );
    
    123 110
     
    
    124
    -% Next are just function and constant.
    
    125
    -% We can define much more.
    
    126
    -
    
    127
    -print_ str = (File_write (File_stdout ()) str);
    
    128
    -
    
    129
    -newline_ = "\n";
    
    111
    +%% Next are example command
    
    130 112
     
    
    131
    -tab_ = "\t";
    
    113
    +print str = (File_write (File_stdout ()) str);
    
    132 114
     
    
    133 115
     return v = IO_return v;
    
    134 116
     
    
    135
    -print v = print_ v;
    
    136
    -
    
    137
    -newline = print newline_;
    
    138
    -
    
    139
    -tab = print tab_;
    
    140
    -
    
    141
    -flt2str v = IO_return (Float->String v);
    
    142
    -
    
    143
    -Hello = action (
    
    144
    -  newline;
    
    145
    -  tab;
    
    146
    -  a <- return "Hello world";
    
    147
    -  b <- return "!";
    
    148
    -  print a;
    
    149
    -  print b;
    
    150
    -  newline;
    
    151
    -  newline;
    
    152
    -  return 0;
    
    153
    -);
    
    154
    -
    117
    +newline = print "\n";
    
    118
    +
    
    119
    +tab = print "\t";
    
    120
    +
    
    121
    +float2string v = IO_return (Float->String v);
    
    122
    +
    
    123
    +%%
    
    124
    +%%    example0 = action (
    
    125
    +%%      str <- return "\n\tHello world!";
    
    126
    +%%      print str;
    
    127
    +%%      return 0.0;
    
    128
    +%%    );
    
    129
    +%%
    
    130
    +%%    example1 = action (
    
    131
    +%%      flt <- example0;
    
    132
    +%%      str <- float2string flt;
    
    133
    +%%      newline;
    
    134
    +%%      tab;
    
    135
    +%%      print str;
    
    136
    +%%      newline;
    
    137
    +%%      newline;
    
    138
    +%%    );
    
    139
    +%%