smalltalk-tng
view r3/test.tng @ 321:c4a0718c2d3c
Sketch of dependencies
| author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
|---|---|
| date | Sat Oct 08 15:36:03 2011 -0400 (7 months ago) |
| parents | 95d1a0e8807d |
| children |
line source
1 define map [
2 f: [#nil : #nil
3 [#hd: h #tl: t] : [#hd: (f h) #tl: (map f t)]]
4 ];;
6 (arg #hd)
7 (arg #tl)
9 "a pattern:" [(a b): _]
10 "-->" (arg (a b))
12 define fold-left [
13 kons: [knil: [#nil : knil
14 [#hd: h #tl: t] : (fold-left kons (kons h knil) t)]]
15 ];;
17 map [x: x + 1] ([1, 2, 3] asList);;
19 "DAMN letrec is a problem piece of syntax"
20 letrec: (map = [f: [#nil : #nil
21 [#hd: h #tl: t] : [#hd: (f h) #tl: (map f t)]]],
22 toList = [[] : #nil
23 [h ; t] : [#hd: h #tl: (toList t)]]) "yikes"
24 in: map [x: x] (toList [1 2 3])
25 ;;
27 map [x: x + 1] (toList [1 2 3]);;
29 [x: (#update: [] #set: x #to: 123)] 'hi';;
31 define-behaviour Cst;;
32 define-method ({Cst cst} #convert) (
33 case: {cst} of: (
34 [ [#adj: [l, r]] : [(l #convert) (r #convert)] ],
35 [ [#tuple: cs] : (let cs* = map [x: x #convert] cs in {Tuple cs*}) ],
36 [ [#quote: v] : v ],
37 [ _ : cst ]
38 )
39 );;
41 "To lift something:" {lifted} <- val
42 "To drop something:" val <- {lifted}
44 define-method ({Tuple x} #length) (
45 x #length
46 );;
48 define-method ({Tuple x} #asList) (
49 (0 .. (x #length)) #map: ((?) x) "'x ? i' means 'read the ith elt of x'"
50 );;
52 "A monadic version:"
53 "(This is stupid code anyway because it's a lazy language,
54 it already delays and evaluates once!)"
55 "We don't put the 'atomic' in here to stay compositional as long as possible"
56 define-method ((results = {ParseResults _}) #next) (
57 [has-value, next] <- (#read: (results #next*)),
58 #if: has-value
59 #then: return next
60 #else: (next-value <- (return (next [])),
61 #into: (results #next*) #write: [#true, next-value],
62 return next-value)
63 );;
65 "iota"
66 define (..) [
67 start: [#inf+: letrec: gen = [x: [#first: x #rest: (gen (x + 1))]] in: gen start
68 #inf-: letrec: gen = [x: [#first: x #rest: (gen (x - 1))]] in: gen start
69 end: letrec: op = (#if: start > end #then: (+) #else: (-)),
70 gen = [x: (#if: x = end
71 #then: #end
72 #else: [#first: x #rest: (gen (op x 1))])]
73 in: gen start]
74 ];;
76 define ($) [f: f];;
77 "
78 f $ a
79 --> ($) f a
80 --> f a
81 "