diff --git a/src/haz3lcore/dune b/src/haz3lcore/dune index 2bfd69309d..620b5cd7b9 100644 --- a/src/haz3lcore/dune +++ b/src/haz3lcore/dune @@ -2,7 +2,7 @@ (library (name haz3lcore) - (libraries util re sexplib unionFind uuidm) + (libraries util re sexplib unionFind uuidm hazel_menhir) (js_of_ocaml (flags (:include js-of-ocaml-flags-%{profile}))) diff --git a/src/haz3lcore/dynamics/DH.re b/src/haz3lcore/dynamics/DH.re index 8967897805..824a4ce14a 100644 --- a/src/haz3lcore/dynamics/DH.re +++ b/src/haz3lcore/dynamics/DH.re @@ -1,4 +1,5 @@ open Sexplib.Std; +open Hazel_menhir.AST; module rec DHExp: { [@deriving (show({with_path: false}), sexp, yojson)] @@ -52,6 +53,8 @@ module rec DHExp: { let strip_casts: t => t; let fast_equal: (t, t) => bool; + + let of_menhir_ast: Hazel_menhir.AST.exp => t; } = { [@deriving (show({with_path: false}), sexp, yojson)] type t = @@ -312,6 +315,56 @@ module rec DHExp: { ) && i1 == i2; }; + + let rec rule_of_menhir_ast = ((pat: Hazel_menhir.AST.pat, exp: Hazel_menhir.AST.exp)) : rule => { + Rule(DHPat.of_menhir_ast(pat), of_menhir_ast(exp)); + } + and of_menhir_ast = (exp: Hazel_menhir.AST.exp) : t => { + switch (exp) { + | Int(i) => IntLit(i) + | Float(f) => FloatLit(f) + | String(s) => StringLit(s) + | Bool(b) => BoolLit(b) + | Var(x) => BoundVar(x) + | ArrayExp(l) => ListLit(Id.mk(), 0, Unknown(SynSwitch), List.map(of_menhir_ast, l)) + | TupleExp(t) => Tuple(List.map(of_menhir_ast, t)) + | Let(p, e1, e2) => Let(DHPat.of_menhir_ast(p), of_menhir_ast(e1), of_menhir_ast(e2)) + | Fun(p, e) => Fun(DHPat.of_menhir_ast(p), Unknown(SynSwitch), of_menhir_ast(e), None) + | Unit => EmptyHole(Id.mk(), 0) + | ApExp(e1, e2) => Ap(of_menhir_ast(e1), of_menhir_ast(e2)) + | BinExp(e1, op, e2) => + { + switch (op) { + | IntOp(op) => BinIntOp(TermBase.UExp.int_op_of_menhir_ast(op), of_menhir_ast(e1), of_menhir_ast(e2)) + | FloatOp(op) => BinFloatOp(TermBase.UExp.float_op_of_menhir_ast(op), of_menhir_ast(e1), of_menhir_ast(e2)) + | BoolOp(op) => BinBoolOp(TermBase.UExp.bool_op_of_menhir_ast(op), of_menhir_ast(e1), of_menhir_ast(e2)) + + } + } + | If(e1, e2, e3) => { + let d_scrut = of_menhir_ast(e1) + let d1 = of_menhir_ast(e2) + let d2 = of_menhir_ast(e3) + + let d_rules = + DHExp.[Rule(BoolLit(true), d1), Rule(BoolLit(false), d2)]; + let d = DHExp.Case(d_scrut, d_rules, 0); + ConsistentCase(d); + } + + | CaseExp(e, l) => { + let d_scrut = of_menhir_ast(e) + let d_rules = List.map(rule_of_menhir_ast, l); + ConsistentCase(Case(d_scrut, d_rules, 0)) + + // raise(Invalid_argument("Menhir Case -> DHExp not yet implemented")); //TODO: add in the slightly irritating translation of the list from the AST form to the DHExp form ConsistentCase(case(of_menhir_ast(e), , 0)) + } + + | Cast(e, t1, t2) => Cast(of_menhir_ast(e), Typ.of_menhir_ast(t1), Typ.of_menhir_ast(t2)) + + // | _ => raise(Invalid_argument("Menhir AST -> DHExp not yet implemented")) + } + } } and Environment: { diff --git a/src/haz3lcore/dynamics/DHPat.re b/src/haz3lcore/dynamics/DHPat.re index 0cac9b9814..45b047a729 100644 --- a/src/haz3lcore/dynamics/DHPat.re +++ b/src/haz3lcore/dynamics/DHPat.re @@ -49,3 +49,15 @@ let rec binds_var = (x: Var.t, dp: t): bool => List.fold_left((||), false, new_list); | Ap(_, _) => false }; + +let rec of_menhir_ast = (pat: Hazel_menhir.AST.pat): t => { + switch (pat) { + | IntPat(i) => IntLit(i) + | FloatPat(f) => FloatLit(f) + | VarPat(x) => Var(x) + | StringPat(s) => StringLit(s) + | TypeAnn(pat, _typ) => of_menhir_ast(pat); + | TuplePat(pats) => Tuple(List.map(of_menhir_ast, pats)) + | ApPat(pat1, pat2) => Ap(of_menhir_ast(pat1), of_menhir_ast(pat2)) + } +}; diff --git a/src/haz3lcore/dynamics/Elaborator.re b/src/haz3lcore/dynamics/Elaborator.re index 4824a77d0a..d80601f3d7 100644 --- a/src/haz3lcore/dynamics/Elaborator.re +++ b/src/haz3lcore/dynamics/Elaborator.re @@ -341,10 +341,15 @@ and dhpat_of_upat = (m: Statics.Map.t, upat: Term.UPat.t): option(DHPat.t) => { //let dhexp_of_uexp = Core.Memo.general(~cache_size_bound=1000, dhexp_of_uexp); -let uexp_elab = (m: Statics.Map.t, uexp: Term.UExp.t): ElaborationResult.t => +let uexp_elab = (m: Statics.Map.t, uexp: Term.UExp.t): ElaborationResult.t => { + let _ = print_endline("uexp_elab"); switch (dhexp_of_uexp(m, uexp)) { - | None => DoesNotElaborate + | None => { + print_endline("dne"); + DoesNotElaborate + } | Some(d) => + print_endline(DH.DHExp.show(d)); //let d = uexp_elab_wrap_builtins(d); let ty = switch (fixed_exp_typ(m, uexp)) { @@ -353,3 +358,4 @@ let uexp_elab = (m: Statics.Map.t, uexp: Term.UExp.t): ElaborationResult.t => }; Elaborates(d, ty, Delta.empty); }; +}; diff --git a/src/haz3lcore/statics/TermBase.re b/src/haz3lcore/statics/TermBase.re index a6297a3061..259ffae6f8 100644 --- a/src/haz3lcore/statics/TermBase.re +++ b/src/haz3lcore/statics/TermBase.re @@ -135,6 +135,10 @@ and UExp: { let int_op_to_string: op_bin_int => string; let float_op_to_string: op_bin_float => string; let string_op_to_string: op_bin_string => string; + + let int_op_of_menhir_ast: Hazel_menhir.AST.op_bin_int => op_bin_int; + let bool_op_of_menhir_ast: Hazel_menhir.AST.op_bin_bool => op_bin_bool; + let float_op_of_menhir_ast: Hazel_menhir.AST.op_bin_float => op_bin_float; } = { [@deriving (show({with_path: false}), sexp, yojson)] type op_un_bool = @@ -194,6 +198,50 @@ and UExp: { | Bool(op_bin_bool) | String(op_bin_string); + [@deriving (show({with_path: false}), sexp, yojson)] + let int_op_of_menhir_ast = (op: Hazel_menhir.AST.op_bin_int): op_bin_int => { + switch (op) { + | Plus => Plus + | Minus => Minus + | Times => Times + | Power => Power + | Divide => Divide + | LessThan => LessThan + | LessThanOrEqual => LessThanOrEqual + | GreaterThan => GreaterThan + | GreaterThanOrEqual => GreaterThanOrEqual + | Equals => Equals + | NotEquals => NotEquals + }; + }; + + [@deriving (show({with_path: false}), sexp, yojson)] + let float_op_of_menhir_ast = + (op: Hazel_menhir.AST.op_bin_float): op_bin_float => { + switch (op) { + | Plus => Plus + | Minus => Minus + | Times => Times + | Power => Power + | Divide => Divide + | LessThan => LessThan + | LessThanOrEqual => LessThanOrEqual + | GreaterThan => GreaterThan + | GreaterThanOrEqual => GreaterThanOrEqual + | Equals => Equals + | NotEquals => NotEquals + }; + }; + + [@deriving (show({with_path: false}), sexp, yojson)] + let bool_op_of_menhir_ast = + (op: Hazel_menhir.AST.op_bin_bool): op_bin_bool => { + switch (op) { + | And => And + | Or => Or + }; + }; + [@deriving (show({with_path: false}), sexp, yojson)] type term = | Invalid(string) diff --git a/src/haz3lcore/statics/TypBase.re b/src/haz3lcore/statics/TypBase.re index 3f614145ab..5bb6ca824d 100644 --- a/src/haz3lcore/statics/TypBase.re +++ b/src/haz3lcore/statics/TypBase.re @@ -1,6 +1,7 @@ open Sexplib.Std; open Util; open OptUtil.Syntax; +open Hazel_menhir.AST; let precedence_Prod = 1; let precedence_Arrow = 2; @@ -68,6 +69,9 @@ module rec Typ: { let sum_entry: (Constructor.t, sum_map) => option(sum_entry); let get_sum_constructors: (Ctx.t, t) => option(sum_map); let is_unknown: t => bool; + + let of_menhir_ast: Hazel_menhir.AST.typ => t; + } = { [@deriving (show({with_path: false}), sexp, yojson)] type type_provenance = @@ -424,6 +428,21 @@ module rec Typ: { | Unknown(_) => true | _ => false }; + + let rec of_menhir_ast = (typ: Hazel_menhir.AST.typ) : t => { + switch (typ) { + | IntType => Int + | FloatType => Float + | BoolType => Bool + | StringType => String + | UnitType => Prod([]) + | TupleType(ts) => Prod(List.map(of_menhir_ast, ts)) + | ArrayType(t) => List(of_menhir_ast(t)) + | ArrowType(t1, t2) => Arrow(of_menhir_ast(t1), of_menhir_ast(t2)) + // | _ => raise(Invalid_argument("Menhir AST -> DHExp not yet implemented")) + } + } + } and Ctx: { [@deriving (show({with_path: false}), sexp, yojson)] diff --git a/src/menhir-parser/AST.re b/src/menhir-parser/AST.re new file mode 100644 index 0000000000..0c592ff81f --- /dev/null +++ b/src/menhir-parser/AST.re @@ -0,0 +1,93 @@ +open Sexplib.Std; + + [@deriving (show({with_path: false}), sexp, yojson)] + type op_bin_float = + | Plus + | Minus + | Times + | Power + | Divide + | LessThan + | LessThanOrEqual + | GreaterThan + | GreaterThanOrEqual + | Equals + | NotEquals; + +[@deriving (show({with_path: false}), sexp, yojson)] + type op_bin_bool = + | And + | Or; + + +[@deriving (show({with_path: false}), sexp, yojson)] +type op_bin_int = + | Plus + | Minus + | Times + | Power + | Divide + | LessThan + | LessThanOrEqual + | GreaterThan + | GreaterThanOrEqual + | Equals + | NotEquals; + // | Equals + // | NotEqual + // | Plus + // | Minus + // | Times + // | Divide + // | Power + // | LessThan + // | GreaterThan + // | LessThanEqual + // | GreaterThanEqual + // | Logical_And + // | Logical_Or + +[@deriving (show({with_path: false}), sexp, yojson)] +type binOp = + | IntOp(op_bin_int) + | FloatOp(op_bin_float) + | BoolOp(op_bin_bool); + +[@deriving (show({with_path: false}), sexp, yojson)] +type typ = + | IntType + | StringType + | FloatType + | BoolType + | UnitType + | TupleType(list(typ)) + | ArrayType(typ) + | ArrowType(typ, typ); + +[@deriving (show({with_path: false}), sexp, yojson)] +type pat = + | IntPat(int) + | FloatPat(float) + | VarPat(string) + | StringPat(string) + | TypeAnn(pat, typ) + | TuplePat(list(pat)) + | ApPat(pat, pat); + +[@deriving (show({with_path: false}), sexp, yojson)] +type exp = + | Int(int) + | Float(float) + | Var(string) + | String(string) + | ArrayExp(list(exp)) + | TupleExp(list(exp)) + | Unit + | BinExp(exp, binOp, exp) + | Let(pat, exp, exp) + | Fun(pat, exp) + | CaseExp(exp, list((pat, exp))) + | ApExp(exp, exp) + | Bool(bool) + | Cast(exp, typ, typ) + | If(exp, exp, exp); diff --git a/src/menhir-parser/Interface.re b/src/menhir-parser/Interface.re new file mode 100644 index 0000000000..dfc8cd5f97 --- /dev/null +++ b/src/menhir-parser/Interface.re @@ -0,0 +1,22 @@ +open Lexing; +let column_num = (pos: position) => { + pos.pos_cnum - pos.pos_bol - 1; +}; + +let string_of_pos = (pos: position) => { + let l = string_of_int(pos.pos_lnum); + let c = string_of_int(column_num(pos) + 1); + "line " ++ l ++ ", column " ++ c; +}; + +let parse = (f, s) => { + let lexbuf = Lexing.from_string(s); + let result = + try(f(Lexer.token, lexbuf)) { + | Parser.Error => + raise(Failure("Parse error at: " ++ string_of_pos(lexbuf.lex_curr_p))) + }; + result; +}; + +let parse_program = s => parse(Parser.program, s); diff --git a/src/menhir-parser/Lexer.mll b/src/menhir-parser/Lexer.mll new file mode 100644 index 0000000000..d2cbf150d5 --- /dev/null +++ b/src/menhir-parser/Lexer.mll @@ -0,0 +1,92 @@ +{ +open Lexing +open Parser + +let advance_line lexbuf = + let pos = lexbuf.lex_curr_p in + let pos' = { pos with + pos_bol = lexbuf.lex_curr_pos; + pos_lnum = pos.pos_lnum + 1 + } in + lexbuf.lex_curr_p <- pos' +} + + +let float = '-'? ['0'-'9']* '.' ['0'-'9']* +let int = '-'? ['0'-'9'] ['0'-'9']* + +let string = '"' ([^ '"' '\\'] | '\\' ['"' '\\'])* '"' + +let newline = '\r' | '\n' | "\r\n" + +let whitespace = [' ' '\t']+ + +let identifier = ['a'-'z' 'A'-'Z' '_'] ['a'-'z' 'A'-'Z' '0'-'9' '_']* + +rule token = + parse + | whitespace {token lexbuf } + | newline { advance_line lexbuf; token lexbuf} + | int as i { INT (int_of_string i) } + | float as f { FLOAT (float_of_string f )} + | string as s { STRING (String.sub s 1 (String.length s - 2)) } + | "true" { TRUE } + | "false" { FALSE } + | "let" { LET } + | "in" { IN } + | "end" { END } + | "fun" { FUN } + | "case" { CASE } + | "if" { IF } + | "then" { THEN } + | "else" { ELSE } + | "as" { AS } + | "{" { OPEN_BRACKET } + | "}" { CLOSE_BRACKET } + | "[" { OPEN_SQUARE_BRACKET } + | "]" { CLOSE_SQUARE_BRACKET } + | "(" { OPEN_PAREN } + | ")" { CLOSE_PAREN } + | "->" { DASH_ARROW } + | "=>" { EQUAL_ARROW } + | "=" { SINGLE_EQUAL } + (* Int ops*) + | "+" { PLUS } + | "-" { MINUS } + | "*" { TIMES } + | "/" { DIVIDE } + | "**" {POWER} + | "==" { DOUBLE_EQUAL } + | "!=" { NOT_EQUAL } + | "<" { LESS_THAN} + | "<=" { LESS_THAN_EQUAL } + | ">" { GREATER_THAN } + | ">=" { GREATER_THAN_EQUAL } + (* Float ops *) + | "+." { PLUS_FLOAT } + | "-." { MINUS_FLOAT } + | "*." { TIMES_FLOAT } + | "/." { DIVIDE_FLOAT } + | "**." {POWER_FLOAT} + | "==." { DOUBLE_EQUAL_FLOAT } + | "!=." { NOT_EQUAL_FLOAT } + | "<." { LESS_THAN_FLOAT} + | "<=." { LESS_THAN_EQUAL_FLOAT } + | ">." { GREATER_THAN_FLOAT } + | ">=." { GREATER_THAN_EQUAL_FLOAT } + (* Bool ops *) + | "&&" { L_AND } + | "||" { L_OR } + | "!" { L_NOT } + | "&" { B_AND } + | "|" { TURNSTILE } + | "," { COMMA } + | ":" { COLON } + | "Int" { INT_TYPE } + | "Float" { FLOAT_TYPE } + | "Bool" { BOOL_TYPE } + | "String" { STRING_TYPE } + | "()" { UNIT } + | identifier as i { IDENT(i) } + | eof { EOF } + | _ { raise (Failure ("Lex error: unknown char: '" ^ Lexing.lexeme lexbuf ^ "'")) } diff --git a/src/menhir-parser/Parser.mly b/src/menhir-parser/Parser.mly new file mode 100644 index 0000000000..6c7f62397a --- /dev/null +++ b/src/menhir-parser/Parser.mly @@ -0,0 +1,171 @@ +%{ +open AST +%} + +%token IDENT +%token STRING +%token TRUE +%token FALSE +%token INT +%token FLOAT +%token LET +%token FUN +%token CASE +%token AS +%token OPEN_BRACKET +%token CLOSE_BRACKET +%token OPEN_SQUARE_BRACKET +%token CLOSE_SQUARE_BRACKET +%token OPEN_PAREN +%token CLOSE_PAREN +%token DASH_ARROW +%token EQUAL_ARROW +%token SINGLE_EQUAL +%token TURNSTILE + +(* Int ops *) +%token DOUBLE_EQUAL +%token NOT_EQUAL +%token PLUS +%token MINUS +%token DIVIDE +%token POWER +%token TIMES +%token LESS_THAN +%token LESS_THAN_EQUAL +%token GREATER_THAN +%token GREATER_THAN_EQUAL +(* Float ops *) +%token DOUBLE_EQUAL_FLOAT +%token NOT_EQUAL_FLOAT +%token PLUS_FLOAT +%token MINUS_FLOAT +%token DIVIDE_FLOAT +%token POWER_FLOAT +%token TIMES_FLOAT +%token LESS_THAN_FLOAT +%token LESS_THAN_EQUAL_FLOAT +%token GREATER_THAN_FLOAT +%token GREATER_THAN_EQUAL_FLOAT +(*logical ops*) +%token L_AND +%token L_OR +%token L_NOT +(*bitwise ops*) +%token B_AND + +%token COMMA +%token COLON +%token EOF +%token IN +%token UNIT +%token END + +(* type tokens *) +%token INT_TYPE +%token FLOAT_TYPE +%token BOOL_TYPE +%token STRING_TYPE + +%token IF +%token THEN +%token ELSE + +%type exp + +%start program + +%% + +program: + | e = exp; EOF {e} + +intOp: + | PLUS { IntOp(Plus) } + | MINUS { IntOp(Minus) } + | TIMES { IntOp(Times) } + | POWER { IntOp(Power) } + | DIVIDE { IntOp(Divide) } + | DOUBLE_EQUAL { IntOp(Equals) } + | NOT_EQUAL { IntOp(NotEquals) } + | LESS_THAN { IntOp(LessThan) } + | LESS_THAN_EQUAL { IntOp(LessThanOrEqual) } + | GREATER_THAN { IntOp(GreaterThan) } + | GREATER_THAN_EQUAL { IntOp(GreaterThanOrEqual) } + + +floatOp: + | PLUS_FLOAT { FloatOp(Plus) } + | MINUS_FLOAT { FloatOp(Minus) } + | TIMES_FLOAT { FloatOp(Times) } + | POWER_FLOAT { FloatOp(Power) } + | DIVIDE_FLOAT { FloatOp(Divide) } + | DOUBLE_EQUAL_FLOAT { FloatOp(Equals) } + | NOT_EQUAL_FLOAT { FloatOp(NotEquals) } + | LESS_THAN_FLOAT { FloatOp(LessThan) } + | LESS_THAN_EQUAL_FLOAT { FloatOp(LessThanOrEqual) } + | GREATER_THAN_FLOAT { FloatOp(GreaterThan) } + | GREATER_THAN_EQUAL_FLOAT { FloatOp(GreaterThanOrEqual) } + +boolOp: + | L_AND { BoolOp(And) } + | L_OR { BoolOp(Or) } + +binOp: + | i = intOp { i } + | f = floatOp { f } + | b = boolOp { b } + +binExp: + | e1 = exp; b = binOp; e2 = exp { BinExp (e1, b, e2) } + +typ: + | INT_TYPE { IntType } + | FLOAT_TYPE { FloatType } + | BOOL_TYPE { BoolType } + | STRING_TYPE { StringType } + | UNIT { UnitType } + | OPEN_PAREN; types = separated_list(COMMA, typ); CLOSE_PAREN { TupleType(types) } + | OPEN_SQUARE_BRACKET; t = typ; CLOSE_SQUARE_BRACKET { ArrayType(t) } + | t1 = typ; DASH_ARROW; t2 = typ { ArrowType(t1, t2) } + +pat: + | i = IDENT { VarPat (i) } + | t = patTuple { t } + | t = typeAnn { t } + | i = INT { IntPat i } + | f = FLOAT { FloatPat f } + | s = STRING { StringPat s} + (* | p1 = pat; AS; p2 = pat; { AsPat(p1, p2) } *) + | f = pat; OPEN_PAREN; a = pat; CLOSE_PAREN { ApPat(f, a) } + + +patTuple: + | OPEN_PAREN; pats = separated_list(COMMA, pat); CLOSE_PAREN { TuplePat(pats) } + +typeAnn: + | p = pat; COLON; t = typ { TypeAnn(p, t) } + +rul: + | TURNSTILE; p = pat; EQUAL_ARROW; e = exp; { (p, e) } + +case: + | CASE; e = exp; l = list(rul); END; { CaseExp(e, l) } + +exp: + | i = INT { Int i } + | f = FLOAT { Float f } + | v = IDENT { Var v } + | s = STRING { String s} + | b = binExp { b } + | OPEN_PAREN; l = separated_list(COMMA, exp) ; CLOSE_PAREN { TupleExp(l)} + | c = case { c } + | UNIT { Unit } + | OPEN_SQUARE_BRACKET; e = separated_list(COMMA, exp); CLOSE_SQUARE_BRACKET { ArrayExp(e) } + | f = exp; OPEN_PAREN; a = exp; CLOSE_PAREN { ApExp(f, a) } + | LET; i = pat; SINGLE_EQUAL; e1 = exp; IN; e2 = exp { Let (i, e1, e2) } + | FUN; t = patTuple; DASH_ARROW; e1 = exp; { Fun (t, e1) } + | IF; e1 = exp; THEN; e2 = exp; ELSE; e3 = exp { If (e1, e2, e3) } + | e1 = exp; LESS_THAN; t1 = typ; EQUAL_ARROW; t2 = typ; GREATER_THAN { Cast(e1, t1, t2) } + | TRUE { Bool true } + | FALSE { Bool false } diff --git a/src/menhir-parser/dune b/src/menhir-parser/dune new file mode 100644 index 0000000000..556d0d6960 --- /dev/null +++ b/src/menhir-parser/dune @@ -0,0 +1,10 @@ +(library + (name hazel_menhir) + (libraries util re sexplib unionFind) + (preprocess + (pps ppx_let ppx_sexp_conv ppx_deriving.show ppx_yojson_conv))) + +(ocamllex Lexer) + +(menhir + (modules Parser)) diff --git a/src/menhir-test/MenhirTest.re b/src/menhir-test/MenhirTest.re new file mode 100644 index 0000000000..dbca866a6b --- /dev/null +++ b/src/menhir-test/MenhirTest.re @@ -0,0 +1,20 @@ +open Hazel_menhir; +open Haz3lcore.DHExp; + +let test_file = "/home/green726/coding/hazel/src/menhir-test/test.hazel"; + +let read_whole_file = (filename): string => { + let ch = open_in_bin(filename); + let s = really_input_string(ch, in_channel_length(ch)); + close_in(ch); + s; +}; + +let file_contents = read_whole_file(test_file); + +// print_endline(AST.show_exp(Hazel_menhir.Interface.parse_program(file_contents))); + +let prog: AST.exp = Hazel_menhir.Interface.parse_program(file_contents); + +let dhexp = of_menhir_ast(prog); +print_endline(show(dhexp)) diff --git a/src/menhir-test/dune b/src/menhir-test/dune new file mode 100644 index 0000000000..402b706a57 --- /dev/null +++ b/src/menhir-test/dune @@ -0,0 +1,31 @@ +; (executable +; (name MenhirTest) +; (libraries base ptmap incr_dom hazel_menhir haz3lcore) +; (preprocess +; (pps ppx_let ppx_sexp_conv ppx_deriving.show ppx_yojson_conv))) + + +(executable + (name MenhirTest) + (libraries sexplib base ptmap incr_dom hazel_menhir haz3lcore) + (modes js) + (js_of_ocaml + (flags + (:include js-of-ocaml-flags-%{profile}))) + (preprocess + (pps js_of_ocaml-ppx ppx_let ppx_sexp_conv ppx_deriving.show ppx_yojson_conv))) + +(env + (dev + (js_of_ocaml + (flags (:standard)))) + (release + (js_of_ocaml + (flags (:standard))))) + + +(rule + (write-file js-of-ocaml-flags-dev "(:standard --debuginfo --noinline)")) + +(rule + (write-file js-of-ocaml-flags-release "(:standard)")) diff --git a/src/menhir-test/test.hazel b/src/menhir-test/test.hazel new file mode 100644 index 0000000000..d444ef69a4 --- /dev/null +++ b/src/menhir-test/test.hazel @@ -0,0 +1,13 @@ +let intsOneElseAdd: ((Int, Int)) -> Int = + fun (x, y) -> + case (x, y) + | (1, 1) => 1 + | _ => x + y + end +in + +let ap_and_inc: (((Int, Int) -> Int), Int) -> Int = + fun (f, x) -> f((x, 2)) + 1 +in + +ap_and_inc((intsOneElseAdd, 1))