r2/test.tng
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 16 Jan 2019 17:15:58 +0000
changeset 438 1fe179d53161
parent 32 6c53aceebafd
permissions -rw-r--r--
Add missing primitive implementation for the plain interpreter.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
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
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    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
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    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
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    56
   Else: (next-value <- (next []),
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    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
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    60
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    61
"A monadic version:"
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    62
"(This is stupid code anyway because it's a lazy language,
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    63
it already delays and evaluates once!)"
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    64
"We don't put the 'atomic' in here to stay compositional as long as possible"
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    65
define-method ((results = {ParseResults _}) Next) (
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    66
  [has-value, next] <- (Read: (results Next*)),
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    67
  (If: has-value
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    68
   Then: return next
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    69
   Else: (next-value <- return (next []),
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    70
	  Into: (results Next*) Write: (True, next-value),
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    71
	  return next-value))
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    72
);;
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    73
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    74
"We don't put the 'atomic' in here to stay compositional as long as possible"
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    75
define-method (var Bump) (
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    76
  Into: var Write: (1 + (Read: var))
d6d37f34aa95 More sketches.
Tony Garnock-Jones <tonyg@lshift.net>
parents: 25
diff changeset
    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
;;