author | Tony Garnock-Jones <tonyg@lshift.net> |
Fri, 21 Oct 2005 18:23:42 +1300 | |
changeset 32 | 6c53aceebafd |
parent 26 | d6d37f34aa95 |
permissions | -rw-r--r-- |
20
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1 |
define map [ |
32
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
2 |
f: [Nil : Nil |
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
3 |
[Hd: h Tl: t] : [Hd: f h Tl: map f t]] |
20
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
4 |
];; |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
5 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
6 |
(arg Hd) |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
7 |
(arg Tl) |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
8 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
9 |
"a pattern:" [(a b): _] |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
10 |
"-->" (arg a b) |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
11 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
12 |
define fold-left [ |
32
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
13 |
kons: [knil: [Nil : knil |
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
14 |
[Hd: h Tl: t] : fold-left kons (kons h knil) t]] |
20
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
15 |
];; |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
16 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
17 |
map [x: x + 1] ([1, 2, 3] AsList);; |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
18 |
|
32
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
19 |
letrec (map = [f: [Nil : Nil |
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
20 |
[Hd: h Tl: t]) : [Hd: f h Tl: map f t]], |
20
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
21 |
toList = [[] : Nil |
32
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
22 |
[h ; t]: [Hd: h Tl: (toList t)]]); "yikes" |
23
ca4c9dac5625
Remove now-redundant parentheses.
Tony Garnock-Jones <tonyg@lshift.net>
parents:
20
diff
changeset
|
23 |
map [x: x] (toList [1 2 3]) |
ca4c9dac5625
Remove now-redundant parentheses.
Tony Garnock-Jones <tonyg@lshift.net>
parents:
20
diff
changeset
|
24 |
;; |
20
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
25 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
26 |
map [x: x + 1] (toList [1 2 3]);; |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
27 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
28 |
[x: (Update: [] Set: x To: 123)] 'hi';; |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
29 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
30 |
define-behaviour Cst;; |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
31 |
define-method ({Cst cst} Convert) ( |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
32 |
Case: {cst} Of: ( |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
33 |
[[Adj: [l, r]]: [(l Convert) (r Convert)]], |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
34 |
[[Tuple: cs]: (let cs* = map [x: x Convert] cs in {Tuple cs*})], |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
35 |
[[Quote: v]: v], |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
36 |
[_: cst] |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
37 |
) |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
38 |
);; |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
39 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
40 |
"To lift something:" {lifted} <- val |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
41 |
"To drop something:" val <- {lifted} |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
42 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
43 |
define-method ({Tuple x} Length) ( |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
44 |
x Length;; |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
45 |
);; |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
46 |
|
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
47 |
define-method ({Tuple x} AsList) ( |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
48 |
(0 .. x Length) Map: [i: x ? i] |
9b9bd39d5e13
Lots of work. Simple evaluator.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
49 |
);; |
25
91504ba80408
Experimenting with let syntax
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
23
diff
changeset
|
50 |
|
26 | 51 |
"A semi- or pseudo-monadic version:" |
25
91504ba80408
Experimenting with let syntax
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
23
diff
changeset
|
52 |
define-method ((results = {ParseResults _}) Next) ( |
26 | 53 |
[has-value, next] <- (atomic Read: (results Next*)), |
25
91504ba80408
Experimenting with let syntax
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
23
diff
changeset
|
54 |
(If: has-value |
91504ba80408
Experimenting with let syntax
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
23
diff
changeset
|
55 |
Then: next |
26 | 56 |
Else: (next-value <- (next []), |
57 |
atomic Into: (results Next*) Write: (True, next-value), |
|
25
91504ba80408
Experimenting with let syntax
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
23
diff
changeset
|
58 |
next-value)) |
91504ba80408
Experimenting with let syntax
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
23
diff
changeset
|
59 |
);; |
26 | 60 |
|
61 |
"A monadic version:" |
|
62 |
"(This is stupid code anyway because it's a lazy language, |
|
63 |
it already delays and evaluates once!)" |
|
64 |
"We don't put the 'atomic' in here to stay compositional as long as possible" |
|
65 |
define-method ((results = {ParseResults _}) Next) ( |
|
66 |
[has-value, next] <- (Read: (results Next*)), |
|
67 |
(If: has-value |
|
68 |
Then: return next |
|
69 |
Else: (next-value <- return (next []), |
|
70 |
Into: (results Next*) Write: (True, next-value), |
|
71 |
return next-value)) |
|
72 |
);; |
|
73 |
||
74 |
"We don't put the 'atomic' in here to stay compositional as long as possible" |
|
75 |
define-method (var Bump) ( |
|
76 |
Into: var Write: (1 + (Read: var)) |
|
77 |
);; |
|
32
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
78 |
|
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
79 |
let valid-orders = map [x: [x, x]] ['sale_date', 'cost', 'address'] in |
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
80 |
let [_, order] = Find: [[l, r]: l == order] In: valid-orders |
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
81 |
IfAbsent: [_, 'sale_date'] |
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
82 |
in ... |
6c53aceebafd
Uncurry test.tng; some new experiments
Tony Garnock-Jones <tonyg@lshift.net>
parents:
26
diff
changeset
|
83 |
;; |