Notes and incomplete work.
authorTony Garnock-Jones <tonygarnockjones@gmail.com>
Tue, 25 May 2010 08:09:57 +1200
changeset 285 034958cf32d9
parent 284 1bf8431909d4
child 286 89a01e56e5a7
Notes and incomplete work.
-rw-r--r-- 1 tonyg staff 3935 Aug 11 2009 boot.tng-modules
-rw-r--r-- 1 tonyg staff 454 Aug 9 2009 calc.tng
-rw-r--r-- 1 tonyg staff 1214 Apr 16 18:18 clojure-sequences-20100416.txt
-rw-r--r-- 1 tonyg staff 2265 Feb 24 13:20 monadic-book.tng
-rw-r--r-- 1 tonyg staff 290 Dec 29 19:37 things-to-consider.txt
etng-r2/boot.tng-modules
etng-r2/calc.tng
etng-r2/clojure-sequences-20100416.txt
etng-r2/monadic-book.tng
etng-r2/things-to-consider.txt
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/etng-r2/boot.tng-modules	Tue May 25 08:09:57 2010 +1200
@@ -0,0 +1,132 @@
+define Continuation platform ->
+  rec Continuation {
+    .raw_callcc fn ->
+      '%assemble' (fn = fn) { .scheme -> ('call-with-current-continuation'
+					   (lambda (k) ('etng-send' fn (list k)))) };
+
+    .callcc fn ->
+      Continuation.raw_callcc { k -> fn {v -> '%assemble' (v = v, k = k) { .scheme -> (k v) } } };
+  }
+};
+
+define extends platform extension base ->
+  '%assemble' (extension = extension, base = base) {
+    .scheme -> ('etng-merge-functions' extension base);
+  };
+
+define as platform receiver via message ->
+  '%assemble' (receiver = receiver, via = via, message = message) {
+    -- FIXME: need some form of apply here, now we are n-ary instead of unary!
+    .scheme -> ('etng-send*' receiver via (list message))
+  };
+
+define :booleanBehaviour = rec {
+  .not -> '%assemble' (x = self) { .scheme -> (not x) };
+};
+
+define :falseProxy = :booleanBehaviour |extends {v -> v.:false};
+define :trueProxy = :booleanBehaviour |extends {v -> v.:true};
+
+define case x options -> options x;
+
+define < = .<;
+define > = .>;
+
+define :symbolProxy = rec {
+  msg -> case self {
+	   .< -> :messageAccumulator {receiver -> receiver} msg;
+	   _ -> error("Cannot send message to symbol", msg);
+	 };
+};
+
+define :messageAccumulator firstSender -> {
+  .> receiver -> firstSender receiver;
+  secondMsg -> :messageAccumulator {receiver -> firstSender receiver secondMsg};
+};
+
+define <> = < >;
+
+define false = '%assemble' () { .scheme -> (not (quote nonfalse)) };
+define true = false.not;
+
+define + = .+;
+define * = .*;
+define == = .==;
+
+define eq x y -> '%assemble' (x = x, y = y) { .scheme -> ('eq?' x y) };
+
+define write x -> '%assemble' (x = x) { .scheme -> (begin (write x) (newline)) };
+
+define :eq = rec {
+  .== other -> '%assemble' (a = self, b = other) { .scheme -> ('eqv?' a b) };
+};
+
+define :numberProxy = rec {
+  .+ other -> '%assemble' (a = self, b = other) { .scheme -> (+ a b) };
+  .* other -> '%assemble' (a = self, b = other) { .scheme -> (* a b) };
+  .< other -> '%assemble' (a = self, b = other) { .scheme -> (< a b) };
+};
+
+define s:empty = { .s:case v -> v.s:empty };
+define s:cons(head, tail) -> { .s:case v -> v.s:next(head, tail) };
+
+define :tupleProxy = rec {
+  .length -> '%assemble' (v = self) { .scheme -> ('vector-length' v) };
+  .get(n) -> '%assemble' (v = self, n = n) { .scheme -> ('vector-ref' v n) };
+  .s:case v -> :tupleIterator(self, 0).s:case v;
+};
+
+define :tupleIterator(tuple, index) ->
+  (index < (tuple.length)) {
+    .:true -> {.s:case v -> v.s:next(tuple.get(index), :tupleIterator(tuple, index + 1))};
+    .:false -> {.s:case v -> v.s:empty};
+  };
+
+define s:do stream fn ->
+  stream .s:case {
+    .s:empty -> .ok;
+    .s:next(head, tail) -> do fn(head); s:do tail fn;
+  };
+
+define s:foldl stream knil kons ->
+  stream .s:case {
+    .s:empty -> knil;
+    .s:next(head, tail) -> s:foldl tail (kons(head, knil)) kons;
+  };
+
+define s:foldr stream knil kons ->
+  stream .s:case {
+    .s:empty -> knil;
+    .s:next(head, tail) -> kons(head, s:foldr tail knil kons);
+  };
+
+define s:reverse stream -> s:foldl stream s:empty s:cons;
+define s:append s1 s2 -> s:foldr s1 s2 s:cons;
+
+define s:foldlK stream knil kons k ->
+  stream .s:case {
+    .s:empty -> k(knil);
+    .s:next(head, tail) -> kons (head, knil) {newSeed -> s:foldlK tail newSeed kons k};
+  };
+
+define s:foldrK stream knil kons k ->
+  stream .s:case {
+    .s:empty -> k(knil);
+    .s:next(head, tail) -> s:foldrK tail knil kons {newSeed -> kons (head, newSeed) k};
+  };
+
+define s:concatenate stream -> s:foldr stream s:empty s:append;
+
+define s:map stream fn -> s:foldr stream s:empty {elt, acc -> s:cons(fn(elt), acc)};
+
+-- s:map (1, 2, 3) {x -> x};
+-- (1, 2, 3) | s:foldr s:empty s:cons | s:do write;
+-- (1, 2) | s:append (3, 4) | s:do write;
+-- (| s:append (3, 4) | s:do write) (1, 2);
+
+-- define xyz = { .x .y .z -> .w ;
+-- 	       .x .y .w -> .a ;
+-- 	       .x .a .z -> 345 };
+-- define xx = xyz.x;
+-- define xy = xx.y;
+-- xx (xy (xy.z)) .z;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/etng-r2/calc.tng	Tue May 25 08:09:57 2010 +1200
@@ -0,0 +1,27 @@
+define expr = {
+  number:n1 "+" expr:n2 -> n1 + n2;
+};
+
+define number = {
+  spaces digit+:digits -> digits |listToString |stringToNumber;
+};
+
+define token xs -> {
+  spaces <{xs}>;
+};
+
+define digit = {
+  c -> (charNumeric c) { .true -> c; .false -> error("expected", "charNumeric", c); };
+};
+
+spaces = {
+  (c -> (charWhitespace c) { .true -> c; .false -> error("expected", "charWhitespace", c) };)+
+    spaces;
+
+  $- $- ...
+
+  -> #t;
+};
+
+
+expr 1 + 2 + 3;
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/etng-r2/clojure-sequences-20100416.txt	Tue May 25 08:09:57 2010 +1200
@@ -0,0 +1,43 @@
+Subject: Clojure's sequences and nil punning
+Time-stamp: <2010-04-16 17:25:01 tonyg>
+From: tonyg
+
+http://clojure.org/lazy
+
+    namespace s = "http://eighty-twenty.org/etng/r1/ns/stream#";
+    define s:foldr stream knil kons ->
+      stream .s:case {
+	.s:empty -> knil;
+	.s:next(head, tail) -> kons(head, s:foldr tail knil kons);
+      };
+    define s:map stream fn -> s:foldr stream s:empty {elt, acc -> s:cons(fn(elt), acc)};
+
+Expand through `s:foldr`, and we get
+
+    define s:map stream fn ->
+      stream .s:case {
+      	.s:empty -> s:empty;
+	.s:next(head, tail) -> s:cons(fn(head), s:map tail fn);
+      };
+
+Delay:
+
+    define nothing = { .case v -> v .nothing };
+    define just x  = { .case v -> v .just x };
+
+    define delay v ->
+      -- Carefully written to avoid holding onto v for too long.
+      -- Needs let rec cell = etc. to avoid the initial cell.set!
+      let cell = ref ();
+      do cell.set { let forced = v ();
+      	       	    do cell.set { forced };
+		    forced };
+      { msg -> cell.get () msg };
+
+Lazy map:
+
+    define s:lazymap stream fn ->
+      delay {stream .s:case {
+      	.s:empty -> s:empty;
+	.s:next(head, tail) = s:cons(delay {fn(head)}, delay {s:map tail fn});
+      }};
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/etng-r2/monadic-book.tng	Tue May 25 08:09:57 2010 +1200
@@ -0,0 +1,55 @@
+namespace m = "http://github.com/leithaus/XTrace/tree/monadic/src/main/book/content/#";
+namespace c = "http://eighty-twenty.org/etng/r1/ns/collection#";
+
+define m:mention reference		-> { .m:expression k -> k .m:mention reference };
+define m:abstraction formals body	-> { .m:expression k -> k .m:abstraction formals body };
+define m:application operation actuals	-> { .m:expression k -> k .m:application operation actuals };
+
+-- Let's imagine we chose a representation for names, separately from
+-- the representation of expressions. How, in eTNG, would we denote
+-- the contract (type) for the constructors and destructors? Separately?
+-- Together with the definitions? Compare with how Newmoon does it
+-- these days, perhaps.
+
+-- Ugh, the expression problem.
+
+define m:freeVariables x ->
+  x.m:expression {
+    .m:mention r	-> c:set.singleton r;
+    .m:abstraction f b	-> (c:set.fromStream f) ++ (m:freeVariables b);
+    .m:application o a	-> a | s:map m:freeVariables | s:foldr (m:freeVariables o) (binop ++);
+  };
+
+define m:closure fn -> { .m:value k -> k .m:closure fn };
+define m:quantity q -> { .m:value k -> k .m:quantity q };
+
+-- Ideally want to define some kind of interface for objects to satisfy.
+--
+--  type Dereferencer = {def apply( m : Mention ) : Value }
+-- type Expansionist =
+--      {def extend( fmls : List[Mention], actls : List[Value] ) : Dereferencer}
+--   type Environment <: (Dereferencer with Expansionist)
+--   type Applicator = Expression => List[Value] => Value
+
+define m:initialApplicator expression actuals ->
+  expression.m:expression {
+    .m:integerExpression i -> m:quantity i;
+    _ -> throw exception("why are we here?");
+  };
+
+define m:reduce (applicator, environment) ->
+  rec reduceExpression { expression ->
+    expression.m:expression {
+      .m:integerExpression i -> m:quantity i;
+      .m:mention v -> environment.m:lookup v;
+      .m:abstraction formals body ->
+	m:closure { actuals ->
+		      let keys = formals | s:map m:mention;
+		      m:reduce (applicator, environment.m:extend(keys, actuals)) body };
+      .m:application operator actuals ->
+	(reduceExpression operator).m:value {
+	  .m:closure fn -> fn (actuals | s:map reduceExpression);
+	  _ -> throw exception("attempt to apply non function");
+	};
+    }
+  };
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/etng-r2/things-to-consider.txt	Tue May 25 08:09:57 2010 +1200
@@ -0,0 +1,4 @@
+29 Dec 2009. Exception hierarchies. How do they fit in with pattern
+matching? With prototypes? Investigate Self's exceptions. (Thought
+inspired by http://www.haskell.org/ghc/docs/6.10.4/html/libraries/base/Control-Exception.html,
+where it talks about exception hierarchies for a compiler.)