Parse records and keyed collection queries

src/lexer.mll

@@ -16,6 +16,14 @@ let keyword = function
   | "if" -> IF
   | "then" -> THEN
   | "else" -> ELSE
+  | "type" -> TYPE
+  | "input" -> INPUT
+  | "collection" -> COLLECTION
+  | "query" -> QUERY
+  | "filter" -> FILTER
+  | "map" -> MAP
+  | "sum" -> SUM
+  | "count" -> COUNT
   | "true" -> BOOL true
   | "false" -> BOOL false
   | text -> IDENT text

src/main.ml

@@ -85,7 +85,7 @@ let load_source path =
   Diagnostic.set_file path;
   Native.read_file path
 
-let parse_source path = Parse.expression (load_source path)
+let parse_source path = Parse.program (load_source path)
 
 let frontend_unavailable () =
   Diagnostic.error Location.none "the delta pipeline beyond parsing is not implemented in this revision"

src/parse.ml

@@ -15,3 +15,42 @@ let unexpected text lexbuf =
 let expression text =
   let lexbuf = Lexing.from_string text in
   try Parser.expr Lexer.token lexbuf with Parsing.Parse_error -> unexpected text lexbuf
+
+let declarations text =
+  let lexbuf = Lexing.from_string text in
+  try Parser.declarations Lexer.token lexbuf with Parsing.Parse_error -> unexpected text lexbuf
+
+let single kind name explain items span_of =
+  match items with
+  | [ item ] -> item
+  | [] -> Diagnostic.error Location.none "the program declares no %s: add `%s`" kind explain
+  | _ :: second :: _ -> Diagnostic.error (span_of second) "the program declares more than one %s" kind
+
+let program text =
+  let items = declarations text in
+  let records = ref [] in
+  let inputs = ref [] in
+  let helpers = ref [] in
+  let queries = ref [] in
+  List.iter
+    (fun item ->
+      match item with
+      | Syntax.DRecord record -> records := record :: !records
+      | Syntax.DInput input -> inputs := input :: !inputs
+      | Syntax.DHelper helper -> helpers := helper :: !helpers
+      | Syntax.DQuery query -> queries := query :: !queries)
+    items;
+  let input =
+    single "input collection" "input collection" "input NAME : collection T"
+      (List.rev !inputs) (fun input -> input.Syntax.in_span)
+  in
+  let query =
+    single "query" "query" "query NAME = EXPRESSION" (List.rev !queries)
+      (fun query -> query.Syntax.q_span)
+  in
+  {
+    Syntax.prog_records = List.rev !records;
+    prog_input = input;
+    prog_helpers = List.rev !helpers;
+    prog_query = query;
+  }

src/parse.mli

@@ -1 +1,2 @@
 val expression : string -> Syntax.expr
+val program : string -> Syntax.program

src/parser.mly

@@ -2,6 +2,9 @@
 open Syntax
 
 let here () = Location.span_of_lexing (Parsing.symbol_start_pos ()) (Parsing.symbol_end_pos ())
+
+let symbol_span index =
+  Location.span_of_lexing (Parsing.rhs_start_pos index) (Parsing.rhs_end_pos index)
 %}
 
 %token <int> INT
@@ -9,6 +12,7 @@ let here () = Location.span_of_lexing (Parsing.symbol_start_pos ()) (Parsing.sym
 %token <string> STRING
 %token <string> IDENT
 %token LET IN FUN IF THEN ELSE
+%token TYPE INPUT COLLECTION QUERY FILTER MAP SUM COUNT
 %token ARROW PIPE AND OR
 %token EQ NE LT LE GT GE
 %token PLUS MINUS STAR SLASH
@@ -17,11 +21,16 @@ let here () = Location.span_of_lexing (Parsing.symbol_start_pos ()) (Parsing.sym
 
 %start expr
 %type <Syntax.expr> expr
+%start declarations
+%type <Syntax.declaration list> declarations
 
 %%
 
 expr:
   | pipeline { $1 }
+  | LET IDENT EQ expr IN expr { make (ELet ($2, $4, $6)) (here ()) }
+  | FUN IDENT ARROW expr { make (ELambda ($2, $4)) (here ()) }
+  | IF expr THEN expr ELSE expr { make (EIf ($2, $4, $6)) (here ()) }
 
 pipeline:
   | disjunction { $1 }
@@ -72,9 +81,10 @@ atom:
   | LPAREN expr COMMA expr_list RPAREN { make (ETuple ($2 :: $4)) (here ()) }
   | LBRACE record_fields RBRACE { make (ERecord $2) (here ()) }
   | atom DOT IDENT { make (EField ($1, $3)) (here ()) }
-  | LET IDENT EQ expr IN expr { make (ELet ($2, $4, $6)) (here ()) }
-  | FUN IDENT ARROW expr { make (ELambda ($2, $4)) (here ()) }
-  | IF expr THEN expr ELSE expr { make (EIf ($2, $4, $6)) (here ()) }
+  | FILTER atom { make (EFilter $2) (here ()) }
+  | MAP atom { make (EMap $2) (here ()) }
+  | SUM { make ESum (here ()) }
+  | COUNT { make ECount (here ()) }
 
 expr_list:
   | expr { [ $1 ] }
@@ -83,3 +93,61 @@ expr_list:
 record_fields:
   | IDENT EQ expr { [ ($1, $3) ] }
   | IDENT EQ expr SEMI record_fields { ($1, $3) :: $5 }
+  | IDENT EQ expr SEMI { [ ($1, $3) ] }
+
+declarations:
+  | decls EOF { List.rev $1 }
+
+decls:
+  | { [] }
+  | decls declaration { $2 :: $1 }
+
+declaration:
+  | TYPE IDENT EQ LBRACE record_field_decls RBRACE {
+      DRecord {
+        rd_name = $2;
+        rd_name_span = symbol_span 2;
+        rd_fields = $5;
+        rd_span = here ();
+      }
+    }
+  | INPUT IDENT COLON type_expr {
+      DInput { in_name = $2; in_name_span = symbol_span 2; in_ty = $4; in_span = here () }
+    }
+  | LET IDENT helper_params EQ expr {
+      DHelper {
+        h_name = $2;
+        h_name_span = symbol_span 2;
+        h_params = $3;
+        h_body = $5;
+        h_span = here ();
+      }
+    }
+  | QUERY IDENT EQ expr {
+      DQuery { q_name = $2; q_name_span = symbol_span 2; q_body = $4; q_span = here () }
+    }
+
+helper_params:
+  | { [] }
+  | helper_param_list { $1 }
+
+helper_param_list:
+  | IDENT { [ $1 ] }
+  | IDENT helper_param_list { $1 :: $2 }
+
+record_field_decls:
+  | IDENT COLON type_expr { [ ($1, $3) ] }
+  | IDENT COLON type_expr SEMI record_field_decls { ($1, $3) :: $5 }
+  | IDENT COLON type_expr SEMI { [ ($1, $3) ] }
+
+type_expr:
+  | IDENT { make_ty (TyName $1) (here ()) }
+  | COLLECTION type_expr { make_ty (TyCollection $2) (here ()) }
+  | LPAREN type_expr RPAREN { $2 }
+  | LPAREN type_expr COMMA type_expr_list RPAREN {
+      make_ty (TyTuple ($2 :: $4)) (here ())
+    }
+
+type_expr_list:
+  | type_expr { [ $1 ] }
+  | type_expr COMMA type_expr_list { $1 :: $3 }

src/syntax.ml

@@ -32,9 +32,67 @@ and expr_desc =
   | ETuple of expr list
   | ERecord of (string * expr) list
   | EField of expr * string
+  | EFilter of expr
+  | EMap of expr
+  | ESum
+  | ECount
+
+type tyexpr = {
+  ty : tyexpr_desc;
+  tyspan : Location.span;
+}
+
+and tyexpr_desc =
+  | TyName of string
+  | TyCollection of tyexpr
+  | TyTuple of tyexpr list
+
+type record_decl = {
+  rd_name : string;
+  rd_name_span : Location.span;
+  rd_fields : (string * tyexpr) list;
+  rd_span : Location.span;
+}
+
+type input_decl = {
+  in_name : string;
+  in_name_span : Location.span;
+  in_ty : tyexpr;
+  in_span : Location.span;
+}
+
+type helper = {
+  h_name : string;
+  h_name_span : Location.span;
+  h_params : string list;
+  h_body : expr;
+  h_span : Location.span;
+}
+
+type query = {
+  q_name : string;
+  q_name_span : Location.span;
+  q_body : expr;
+  q_span : Location.span;
+}
+
+type declaration =
+  | DRecord of record_decl
+  | DInput of input_decl
+  | DHelper of helper
+  | DQuery of query
+
+type program = {
+  prog_records : record_decl list;
+  prog_input : input_decl;
+  prog_helpers : helper list;
+  prog_query : query;
+}
 
 let make e espan = { e = e; espan = espan }
 
+let make_ty ty tyspan = { ty = ty; tyspan = tyspan }
+
 let binop_name = function
   | Add -> "+"
   | Sub -> "-"
@@ -50,3 +108,9 @@ let binop_name = function
   | Or -> "||"
 
 let string_of_binop = binop_name
+
+let rec string_of_tyexpr tyexpr =
+  match tyexpr.ty with
+  | TyName name -> name
+  | TyCollection element -> "collection " ^ string_of_tyexpr element
+  | TyTuple elements -> "(" ^ String.concat ", " (List.map string_of_tyexpr elements) ^ ")"