r3/test.tng
author Tony Garnock-Jones <tonygarnockjones@gmail.com>
Wed, 16 Jan 2019 17:15:58 +0000
changeset 438 1fe179d53161
parent 37 d6705902e67b
permissions -rw-r--r--
Add missing primitive implementation for the plain interpreter.
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     1
define map [
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
     2
  f: [#nil            : #nil
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
     3
      [#hd: h #tl: t] : [#hd: (f h) #tl: (map f t)]]
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     4
];;
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     5
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
     6
(arg #hd)
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
     7
(arg #tl)
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     8
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
     9
"a pattern:" [(a b): _]
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    10
"-->" (arg (a b))
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    11
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    12
define fold-left [
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    13
  kons: [knil: [#nil            : knil
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    14
                [#hd: h #tl: t] : (fold-left kons (kons h knil) t)]]
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    15
];;
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    16
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    17
map [x: x + 1] ([1, 2, 3] asList);;
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    18
37
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    19
"DAMN letrec is a problem piece of syntax"
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    20
letrec: (map = [f: [#nil            : #nil
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    21
	            [#hd: h #tl: t] : [#hd: (f h) #tl: (map f t)]]],
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    22
	 toList = [[]      : #nil
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    23
		   [h ; t] : [#hd: h #tl: (toList t)]]) "yikes"
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    24
in: map [x: x] (toList [1 2 3])
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    25
;;
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    26
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    27
map [x: x + 1] (toList [1 2 3]);;
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    28
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    29
[x: (#update: [] #set: x #to: 123)] 'hi';;
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    30
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    31
define-behaviour Cst;;
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    32
define-method ({Cst cst} #convert) (
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    33
  case: {cst} of: (
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    34
    [ [#adj: [l, r]] : [(l #convert) (r #convert)] ],
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    35
    [   [#tuple: cs] : (let cs* = map [x: x #convert] cs in {Tuple cs*}) ],
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    36
    [    [#quote: v] : v ],
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    37
    [              _ : cst ]
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    38
  )
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    39
);;
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    40
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    41
"To lift something:" {lifted} <- val
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    42
"To drop something:" val <- {lifted}
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    43
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    44
define-method ({Tuple x} #length) (
36
95d1a0e8807d Remove unwanted end-of-toplevel-statement marker
Tony Garnock-Jones <tonyg@lshift.net>
parents: 35
diff changeset
    45
  x #length
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    46
);;
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    47
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    48
define-method ({Tuple x} #asList) (
35
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 34
diff changeset
    49
  (0 .. (x #length)) #map: ((?) x) "'x ? i' means 'read the ith elt of x'"
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    50
);;
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    51
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    52
"A monadic version:"
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    53
"(This is stupid code anyway because it's a lazy language,
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    54
it already delays and evaluates once!)"
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    55
"We don't put the 'atomic' in here to stay compositional as long as possible"
34
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    56
define-method ((results = {ParseResults _}) #next) (
570a02bb7a27 New, more uniform syntax. Evaluator needs updating.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 33
diff changeset
    57
  [has-value, next] <- (#read: (results #next*)),
35
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 34
diff changeset
    58
  #if: has-value
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 34
diff changeset
    59
  #then: return next
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 34
diff changeset
    60
  #else: (next-value <- (return (next [])),
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 34
diff changeset
    61
	  #into: (results #next*) #write: [#true, next-value],
0415292cf581 Printer for ThiNG CST; improved emacs mode, including comint run-tng.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 34
diff changeset
    62
	  return next-value)
33
ca497a9ada93 Move to R3.
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff changeset
    63
);;
37
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    64
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    65
"iota"
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    66
define (..) [
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    67
  start: [#inf+: letrec: gen = [x: [#first: x #rest: (gen (x + 1))]] in: gen start
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    68
          #inf-: letrec: gen = [x: [#first: x #rest: (gen (x - 1))]] in: gen start
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    69
	  end: letrec: op = (#if: start > end #then: (+) #else: (-)),
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    70
                       gen = [x: (#if: x = end
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    71
				  #then: #end
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    72
				  #else: [#first: x #rest: (gen (op x 1))])]
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    73
	       in: gen start]
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    74
];;
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    75
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    76
define ($) [f: f];;
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    77
"
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    78
f $ a
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    79
--> ($) f a
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    80
--> f a
d6705902e67b Notes on syntax and more examples
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents: 36
diff changeset
    81
"