gistfile1.txt

require('source-map-support').install()

function displayln(x) {
  console.log(x);
}

/*** CONTROL CONSTRUCTS ***/

/* when expr body
   Racket when */

macro when_msg { case {_} => { return #{
   "The syntax of when is one of:\n" 
 + "    when (<expr>) <expr>; \n" 
 + "    when (<expr>) {<statement> ...}; \n"}}}

macro when {
  case { _ ($e:expr) $body ...} 
    => {return #{if ($e) $body ...} }
  case { _ ($e:expr) {$body (;) ...} } 
    => {return #{if ($e) {$body (;) ... }} }
  case { $stx ($e:expr) $more ...} 
    => { throwSyntaxError("when",
         "expected a single body after the expression\n"
         + when_msg + "got: ", #{$more ...}) }
  case { $stx ...} 
    => { throwSyntaxError("when", when_msg + "got: ", #{$stx ...}) }
}

/* unless expr body
   Racket unless */

macro unless {
  case { _ $e $s ...} 
    => {return #{if (!($e)) $s ...}}}


/* rif expr expr1 expr2
   equivalent to (expr ? expr1 : expr2)  
   Note: The Javascript if is a "statement-if", so this is the "expression-if" */

macro rif {
  case {_ ($e:expr, $e1:expr, $e2:expr)}
    => {return #{(($e) ? ($e1) : ($e2))}}}


/* cond [expr body] ...
   cond [expr body] ... [else default]
   Racket cond, except body here is a single expression */

macro cond {
  case { _ [$e:expr => $result:expr] $more ... }
    => { return #{ rif($e, $result, (cond $more ...))}}
  case { _ [$e:expr    $result:expr] $more ... }
    => { return #{ rif($e, $result, (cond $more ...))}}
  case { _ [$[else] $e:expr]}
    => {return #{$e}} 
  case { _ }    
    => {return #{ void(0) }} }

/*** BINDING CONSTRUCTS ***/

/* rlet (id=expr, ...) body
   Racket let binding */   

macro rlet {
  case { _ ( ) {$body:expr}}
    => { return #{ (function () {return $body} )()} }  
  case { _ ( $($id:ident = $val:expr) (,) ... ) {$e:expr (;) ... $body:expr} }
    => { return #{(function ($id (,) ...) {$e (;) ... ; return $body})($val (,) ...)} } 
  case { _ ( ) $body}
    => { return #{ (function () $body )()} }
  case { _ ( $($id:ident = $val:expr) (,) ... ) $body }
    => { return #{(function ($id (,) ...) $body)($val (,) ...)} } }

macro rlets {
  case { _ () {$body:expr} }
    => { return #{ rlet (){$body} } }
  case { _ ( $($id:ident = $val:expr) (,) ... ) {$e:expr (;)... $body:expr}  }
    => { return #{ rlet ($($id=0)(,)...) {$($id=$val) (;) ... ; $e (;) ... $body } } }
  case { _ ( ) $body}
    => { return #{ (function () $body )()} }
  case { _ ( $($id:ident = $val:expr) (,) ... ) {$body ...} }                   /* HERE */
    => { return #{ rlet ($($id=0)(,)...) {$($id=$val) (;) ... ; $body ...} } }
}

displayln( "--- rlets ---");
displayln( rlets(){"ok"} ); 
displayln( rlets(a=7,b=a+1){rif(a+b==15,"ok","fail")} ); 
displayln( rlets(){var x=2 ; return "ok"} ); 
/* displayln( rlets(a=7,b=a+1){var x=3; return rif(a+b==18,"ok","fail")} );   */  /* TODO */

/*** FUNCTIONS ***/

macro λ {	
   case { _ { $result:expr} } 
     => { return #{(function () {return $result }) } }
   case { _ { $stat} } 
     => { return #{(function () {$stat }) } }
	case { _ { $e:expr ... ; $result:expr} }
     => { return #{(function () {$e ... ; return $result }) } }}

/*** TESTS ***/

displayln("--- cond tests ---")
/* displayln( cond ); */
displayln( cond [43 "ok"] );
var x=1; displayln( cond [x===1  "ok"] [x===2  "2"]  [x===3  "3"] ); 
var x=2; displayln( cond [x===1  1]    [x===2  "ok"] [x===3  "3"] ); 
var x=3; displayln( cond [x===1  1]    [x===2  "2"]  [else   "ok"] ); 

displayln("--- when and unless ---");
when( 2>3 ) displayln("fail") ;
when( 2<3 ) { "mumble"; displayln("ok")};
unless (1===2) { displayln("ok"); }
unless (1===1) { displayln("fail"); }

displayln("--- rif ---");
var x=1; 
displayln( rif(x==1,"ok","fail"));
displayln( rif(x==2,"fail","ok") );

displayln("--- cond ---");
var x=1;
displayln( cond [x==1 "ok"]   [else "fail"] );
displayln( cond [x==2 "fail"] [x==1 "ok"] [else "fail"] );
displayln( cond [x==2 "fail"] [x==3 "fail"] [else "ok"] );
displayln("undefined: ");
displayln(cond);


displayln("--- rlet ---");
rlet( a=1, b=2) { displayln(rif(a+b==3,"ok","fail")) };
displayln( rif( (rlet(){var y=43; return y})==43,"ok","fail" ));
displayln( rif( (rlet(a=1){ return a;})==1, "ok", "fail"));
displayln( cond [(rlet(a=1,b=2){a+b})==3 "ok"] [else "fail"] );
displayln( cond [(rlet(a=1,b=2){return a+b})==3 "ok"] [else "fail"] );
displayln( cond [(rlet(a=1,b=2){42;        a+b})==3 "ok"] [else "fail"] );  /* this fails bc return */
displayln( cond [(rlet(a=1,b=2){42; return a+b})==3 "ok"] [else "fail"] );

displayln("--- λ ---");
var f = λ{ rlet(y=1){y+5} }; 
var g = λ{ 1+2; 5};
var h = λ{ 5};
displayln([f(),g(),h(),rlet(y=1){ y+5}]);
displayln(rlet(){42});