|
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
|
+%%
|