Source

blub / blub_parse.mly

%{
open Printf
open Blub_types
open Blub_ast.Ast
open Blub_common

let mkvar name = name ;;
%}


/* Ocamlyacc declarations */

%token WHITESPACE
%token LPAREN RPAREN
%token <string> IDENTIFIER
%token <int> INTEGER
%token <float> FLOAT
%token <bool> BOOLEAN
%token <string> STRING
%token QUOTE TINYQUOTE IF BEGIN LAMBDA LET LETREC LETSTAR DEFINE DOT SET CALLCC SHIFT RESET
%token COND ELSE ARROW

%start command_or_definition
%type <Blub_ast.Ast.expr_or_def> command_or_definition

%%


command_or_definition:
  command { Expr $1 }
| definition { let name, expr = $1 in Def(name, expr) }  
| LPAREN BEGIN definitions RPAREN { assert false }
/* TODO syntax definition */
;

command: expr { $1 }

expr: 
  variable { Ref $1 }
| literal { $1 }
| LPAREN IF expr expr expr RPAREN { Cnd ($3, $4, $5) }
| LPAREN IF expr expr RPAREN { Cnd ($3, $4, Lit Snull) }
| cond { $1 }
| LPAREN BEGIN sequence RPAREN { $3 }
| assignment { $1 }
| lambda { $1 }
| letexpr { $1 }
| LPAREN SHIFT variable expr RPAREN { App (Ref (mkvar "control*"), 
					   [| Abs ([|$3|], false, $4) |]) } 
| LPAREN RESET expr RPAREN { App (Ref (mkvar "prompt*"), 
				  [| Abs ([||], false, $3) |] ) }
| LPAREN CALLCC expr RPAREN { Callcc $3 }  /* FIXME can I restrict it to variable or lambda? */
| list { let hd :: tl = $1 in
	 App (hd, Array.of_list tl) }	   
;

assignment:
  LPAREN SET variable expr RPAREN { Set ($3, $4) }

variable:
  IDENTIFIER { mkvar $1 }
;

cond:
|  LPAREN COND cond_clauses RPAREN 
    { let clauses = $3 in
      let expr = List.fold_left 
	(fun alt (pred, cons, arrow) ->
	   if arrow then
	     let fakevar = mkvar "fake" in
	     let expr = Let( [| fakevar, pred |],
			     Cnd(Ref fakevar, 
				 App (cons, [| Ref fakevar |]), alt),
			     LT_let) in
	       expr
	   else
	   Cnd(pred, cons, alt)) (Lit Snull) clauses
      in
      expr } 
;

cond_clauses:
  cond_clauses cond_clause { $2 :: $1 }
| cond_clause { [$1] }
;


cond_clause:
  LPAREN expr sequence RPAREN { ($2, $3, false) }
| LPAREN expr ARROW expr RPAREN { ($2, $4, true) }
| LPAREN ELSE sequence RPAREN { (Lit Strue, $3, false) }
;

literal:
  INTEGER { Lit (Sint $1) }
| FLOAT { Lit (Sfloat $1) }
| BOOLEAN { Lit (if $1 then Strue else Sfalse) }
| LPAREN QUOTE datum RPAREN { Lit $3 }
| TINYQUOTE datum { Lit $2 }
| STRING { Lit (Sstring $1) }
;

lambda:
  LPAREN LAMBDA formals body RPAREN 
  { let params, varargs = $3 in
    Abs (params, varargs, $4) }
;

formals:
  LPAREN variable_star RPAREN { (Array.of_list $2, false) }
| variable { ([| $1 |], true) }
 | LPAREN variable_star DOT variable RPAREN
      { let params = $2  @ [$4] in
	(Array.of_list params, true) }
;  
			
variable_star:
  variable_star variable { List.append $1 [$2] }
| { [] }
;
		  
letexpr:
  LPAREN LETREC bindings body RPAREN { Let (Array.of_list $3, $4, LT_letrec) }
| LPAREN LET bindings body RPAREN { Let (Array.of_list $3, $4, LT_let) }
| LPAREN LETSTAR bindings body RPAREN { Let (Array.of_list $3, $4, LT_letstar) }
| LPAREN LET variable bindings body RPAREN 
      { let params = List.map fst $4 in
	let args = List.map snd $4 in
	Let ( [| $3, Abs (Array.of_list params, false, $5) |],
	      App (Ref $3, Array.of_list args),
	      LT_letrec) }
;

bindings:
  LPAREN inner_bindings RPAREN { List.rev $2 }
;

inner_bindings:
  inner_bindings LPAREN variable expr RPAREN { ($3, $4) :: $1 }
| { [] }
;

body:
  definitions sequence 
  { Let (Array.of_list $1,
	 $2,
	 LT_letrec) }
| sequence { $1 }
;

definitions:
  definitions definition { $2 :: $1 }
| definition { [$1] }
;

definition:
  LPAREN DEFINE variable expr RPAREN { ($3, $4) }
| LPAREN DEFINE LPAREN variable def_formals RPAREN body RPAREN 
      { let params, varargs = $5 in
	$4, Abs(params, varargs, $7) }
| LPAREN BEGIN definitions RPAREN { assert false }
;

def_formals:
  variable_star { (Array.of_list $1, false) }
| variable_star DOT variable { (Array.of_list ($1 @ [$3]), true) }
;

sequence:
  sequence_inner { Seq (Array.of_list (List.rev $1)) }
;

sequence_inner:
  expr { [$1] }
| sequence_inner expr { $2 :: $1 }
;


datum:
  BOOLEAN { if $1 then Strue else Sfalse }
| INTEGER { Sint $1 }
| LPAREN datum_list RPAREN { Blub_list.slist_of_list $2 }
| symbol { $1 }
;

symbol:
  IDENTIFIER { Ssymbol $1 }
;

datum_list:
  inner_datum_list { List.rev $1 }
;

inner_datum_list:
  inner_datum_list datum { $2 :: $1 }
| { [] }
;

list:
  LPAREN list_elements RPAREN { $2 }
;

list_elements: 
  inner_list_elements { List.rev $1 }
;

inner_list_elements:
  inner_list_elements expr { $2 :: $1 }
| { [] }
;