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.

define map [
  f: [#nil            : #nil
      [#hd: h #tl: t] : [#hd: (f h) #tl: (map f t)]]
];;

(arg #hd)
(arg #tl)

"a pattern:" [(a b): _]
"-->" (arg (a b))

define fold-left [
  kons: [knil: [#nil            : knil
                [#hd: h #tl: t] : (fold-left kons (kons h knil) t)]]
];;

map [x: x + 1] ([1, 2, 3] asList);;

"DAMN letrec is a problem piece of syntax"
letrec: (map = [f: [#nil            : #nil
	            [#hd: h #tl: t] : [#hd: (f h) #tl: (map f t)]]],
	 toList = [[]      : #nil
		   [h ; t] : [#hd: h #tl: (toList t)]]) "yikes"
in: map [x: x] (toList [1 2 3])
;;

map [x: x + 1] (toList [1 2 3]);;

[x: (#update: [] #set: x #to: 123)] 'hi';;

define-behaviour Cst;;
define-method ({Cst cst} #convert) (
  case: {cst} of: (
    [ [#adj: [l, r]] : [(l #convert) (r #convert)] ],
    [   [#tuple: cs] : (let cs* = map [x: x #convert] cs in {Tuple cs*}) ],
    [    [#quote: v] : v ],
    [              _ : cst ]
  )
);;

"To lift something:" {lifted} <- val
"To drop something:" val <- {lifted}

define-method ({Tuple x} #length) (
  x #length
);;

define-method ({Tuple x} #asList) (
  (0 .. (x #length)) #map: ((?) x) "'x ? i' means 'read the ith elt of x'"
);;

"A monadic version:"
"(This is stupid code anyway because it's a lazy language,
it already delays and evaluates once!)"
"We don't put the 'atomic' in here to stay compositional as long as possible"
define-method ((results = {ParseResults _}) #next) (
  [has-value, next] <- (#read: (results #next*)),
  #if: has-value
  #then: return next
  #else: (next-value <- (return (next [])),
	  #into: (results #next*) #write: [#true, next-value],
	  return next-value)
);;

"iota"
define (..) [
  start: [#inf+: letrec: gen = [x: [#first: x #rest: (gen (x + 1))]] in: gen start
          #inf-: letrec: gen = [x: [#first: x #rest: (gen (x - 1))]] in: gen start
	  end: letrec: op = (#if: start > end #then: (+) #else: (-)),
                       gen = [x: (#if: x = end
				  #then: #end
				  #else: [#first: x #rest: (gen (op x 1))])]
	       in: gen start]
];;

define ($) [f: f];;
"
f $ a
--> ($) f a
--> f a
"