Add support for Reason (#3336)

This commit is contained in:
Darin Morrison
2016-12-22 18:03:18 -07:00
committed by Brandon Black
parent a4d12cc8e4
commit 7867b946b9
14 changed files with 3867 additions and 1 deletions

4
.gitmodules vendored
View File

@@ -809,4 +809,6 @@
[submodule "vendor/grammars/rascal-syntax-highlighting"]
path = vendor/grammars/rascal-syntax-highlighting
url = https://github.com/usethesource/rascal-syntax-highlighting
[submodule "vendor/grammars/reason"]
path = vendor/grammars/reason
url = https://github.com/facebook/reason

View File

@@ -541,6 +541,9 @@ vendor/grammars/r.tmbundle:
- text.tex.latex.rd
vendor/grammars/rascal-syntax-highlighting:
- source.rascal
vendor/grammars/reason:
- source.reason
- source.reason.hover.type
vendor/grammars/ruby-slim.tmbundle:
- text.slim
vendor/grammars/ruby.tmbundle:

View File

@@ -499,6 +499,7 @@ C++:
- ".inc"
- ".inl"
- ".ipp"
- ".re"
- ".tcc"
- ".tpp"
language_id: 43
@@ -3548,6 +3549,19 @@ Raw token data:
tm_scope: none
ace_mode: text
language_id: 318
Reason:
type: programming
group: OCaml
ace_mode: rust
codemirror_mode: rust
codemirror_mime_type: text/x-rustsrc
extensions:
- ".re"
- ".rei"
interpreters:
- ocaml
tm_scope: source.reason
language_id: 869538413
Rebol:
type: programming
color: "#358a5b"

View File

@@ -0,0 +1,46 @@
#include <iostream>
#define YYCTYPE unsigned char
#define YYCURSOR cursor
#define YYLIMIT cursor
#define YYMARKER marker
#define YYFILL(n)
bool scan(const char *text)
{
YYCTYPE *start = (YYCTYPE *)text;
YYCTYPE *cursor = (YYCTYPE *)text;
YYCTYPE *marker = (YYCTYPE *)text;
next:
YYCTYPE *token = cursor;
/*!re2c
'(This file must be converted with BinHex 4.0)'
{
if (token == start || *(token - 1) == '\n')
return true; else goto next;
}
[\001-\377]
{ goto next; }
[\000]
{ return false; }
*/
return false;
}
#define do_scan(str, expect) \
res = scan(str) == expect ? 0 : 1; \
std::cerr << str << "\t-\t" << (res ? "fail" : "ok") << std::endl; \
result += res
/*!max:re2c */
int main(int,void**)
{
int res, result = 0;
do_scan("(This file must be converted with BinHex 4.0)", 1);
do_scan("x(This file must be converted with BinHex 4.0)", 0);
do_scan("(This file must be converted with BinHex 4.0)x", 1);
do_scan("x(This file must be converted with BinHex 4.0)x", 0);
return result;
}

239
samples/C++/cnokw.re Normal file
View File

@@ -0,0 +1,239 @@
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#define ADDEQ 257
#define ANDAND 258
#define ANDEQ 259
#define ARRAY 260
#define ASM 261
#define AUTO 262
#define BREAK 263
#define CASE 264
#define CHAR 265
#define CONST 266
#define CONTINUE 267
#define DECR 268
#define DEFAULT 269
#define DEREF 270
#define DIVEQ 271
#define DO 272
#define DOUBLE 273
#define ELLIPSIS 274
#define ELSE 275
#define ENUM 276
#define EQL 277
#define EXTERN 278
#define FCON 279
#define FLOAT 280
#define FOR 281
#define FUNCTION 282
#define GEQ 283
#define GOTO 284
#define ICON 285
#define ID 286
#define IF 287
#define INCR 288
#define INT 289
#define LEQ 290
#define LONG 291
#define LSHIFT 292
#define LSHIFTEQ 293
#define MODEQ 294
#define MULEQ 295
#define NEQ 296
#define OREQ 297
#define OROR 298
#define POINTER 299
#define REGISTER 300
#define RETURN 301
#define RSHIFT 302
#define RSHIFTEQ 303
#define SCON 304
#define SHORT 305
#define SIGNED 306
#define SIZEOF 307
#define STATIC 308
#define STRUCT 309
#define SUBEQ 310
#define SWITCH 311
#define TYPEDEF 312
#define UNION 313
#define UNSIGNED 314
#define VOID 315
#define VOLATILE 316
#define WHILE 317
#define XOREQ 318
#define EOI 319
typedef unsigned int uint;
typedef unsigned char uchar;
#define BSIZE 8192
#define YYCTYPE uchar
#define YYCURSOR cursor
#define YYLIMIT s->lim
#define YYMARKER s->ptr
#define YYFILL(n) {cursor = fill(s, cursor);}
#define RET(i) {s->cur = cursor; return i;}
typedef struct Scanner {
int fd;
uchar *bot, *tok, *ptr, *cur, *pos, *lim, *top, *eof;
uint line;
} Scanner;
uchar *fill(Scanner *s, uchar *cursor){
if(!s->eof){
uint cnt = s->tok - s->bot;
if(cnt){
memcpy(s->bot, s->tok, s->lim - s->tok);
s->tok = s->bot;
s->ptr -= cnt;
cursor -= cnt;
s->pos -= cnt;
s->lim -= cnt;
}
if((s->top - s->lim) < BSIZE){
uchar *buf = (uchar*) malloc(((s->lim - s->bot) + BSIZE)*sizeof(uchar));
memcpy(buf, s->tok, s->lim - s->tok);
s->tok = buf;
s->ptr = &buf[s->ptr - s->bot];
cursor = &buf[cursor - s->bot];
s->pos = &buf[s->pos - s->bot];
s->lim = &buf[s->lim - s->bot];
s->top = &s->lim[BSIZE];
free(s->bot);
s->bot = buf;
}
if((cnt = read(s->fd, (char*) s->lim, BSIZE)) != BSIZE){
s->eof = &s->lim[cnt]; *(s->eof)++ = '\n';
}
s->lim += cnt;
}
return cursor;
}
int scan(Scanner *s){
uchar *cursor = s->cur;
std:
s->tok = cursor;
/*!re2c
any = [\000-\377];
O = [0-7];
D = [0-9];
L = [a-zA-Z_];
H = [a-fA-F0-9];
E = [Ee] [+-]? D+;
FS = [fFlL];
IS = [uUlL]*;
ESC = [\\] ([abfnrtv?'"\\] | "x" H+ | O+);
*/
/*!re2c
"/*" { goto comment; }
L (L|D)* { RET(ID); }
("0" [xX] H+ IS?) | ("0" D+ IS?) | (D+ IS?) |
(['] (ESC|any\[\n\\'])* ['])
{ RET(ICON); }
(D+ E FS?) | (D* "." D+ E? FS?) | (D+ "." D* E? FS?)
{ RET(FCON); }
(["] (ESC|any\[\n\\"])* ["])
{ RET(SCON); }
"..." { RET(ELLIPSIS); }
">>=" { RET(RSHIFTEQ); }
"<<=" { RET(LSHIFTEQ); }
"+=" { RET(ADDEQ); }
"-=" { RET(SUBEQ); }
"*=" { RET(MULEQ); }
"/=" { RET(DIVEQ); }
"%=" { RET(MODEQ); }
"&=" { RET(ANDEQ); }
"^=" { RET(XOREQ); }
"|=" { RET(OREQ); }
">>" { RET(RSHIFT); }
"<<" { RET(LSHIFT); }
"++" { RET(INCR); }
"--" { RET(DECR); }
"->" { RET(DEREF); }
"&&" { RET(ANDAND); }
"||" { RET(OROR); }
"<=" { RET(LEQ); }
">=" { RET(GEQ); }
"==" { RET(EQL); }
"!=" { RET(NEQ); }
";" { RET(';'); }
"{" { RET('{'); }
"}" { RET('}'); }
"," { RET(','); }
":" { RET(':'); }
"=" { RET('='); }
"(" { RET('('); }
")" { RET(')'); }
"[" { RET('['); }
"]" { RET(']'); }
"." { RET('.'); }
"&" { RET('&'); }
"!" { RET('!'); }
"~" { RET('~'); }
"-" { RET('-'); }
"+" { RET('+'); }
"*" { RET('*'); }
"/" { RET('/'); }
"%" { RET('%'); }
"<" { RET('<'); }
">" { RET('>'); }
"^" { RET('^'); }
"|" { RET('|'); }
"?" { RET('?'); }
[ \t\v\f]+ { goto std; }
"\n"
{
if(cursor == s->eof) RET(EOI);
s->pos = cursor; s->line++;
goto std;
}
any
{
printf("unexpected character: %c\n", *s->tok);
goto std;
}
*/
comment:
/*!re2c
"*/" { goto std; }
"\n"
{
if(cursor == s->eof) RET(EOI);
s->tok = s->pos = cursor; s->line++;
goto comment;
}
any { goto comment; }
*/
}
main(){
Scanner in;
int t;
memset((char*) &in, 0, sizeof(in));
in.fd = 0;
while((t = scan(&in)) != EOI){
/*
printf("%d\t%.*s\n", t, in.cur - in.tok, in.tok);
printf("%d\n", t);
*/
}
close(in.fd);
}

63
samples/C++/cvsignore.re Normal file
View File

@@ -0,0 +1,63 @@
#define YYFILL(n) if (cursor >= limit) break;
#define YYCTYPE char
#define YYCURSOR cursor
#define YYLIMIT limit
#define YYMARKER marker
/*!re2c
any = (.|"\n");
value = (":" (.\"$")+)?;
cvsdat = "Date";
cvsid = "Id";
cvslog = "Log";
cvsrev = "Revision";
cvssrc = "Source";
*/
#define APPEND(text) \
append(output, outsize, text, sizeof(text) - sizeof(YYCTYPE))
inline void append(YYCTYPE *output, size_t & outsize, const YYCTYPE * text, size_t len)
{
memcpy(output + outsize, text, len);
outsize += (len / sizeof(YYCTYPE));
}
void scan(YYCTYPE *pText, size_t *pSize, int *pbChanged)
{
// rule
// scan lines
// find $ in lines
// compact $<keyword>: .. $ to $<keyword>$
YYCTYPE *output;
const YYCTYPE *cursor, *limit, *marker;
cursor = marker = output = *pText;
size_t insize = *pSize;
size_t outsize = 0;
limit = cursor + insize;
while(1) {
loop:
/*!re2c
"$" cvsdat value "$" { APPEND(L"$" L"Date$"); goto loop; }
"$" cvsid value "$" { APPEND(L"$" L"Id$"); goto loop; }
"$" cvslog value "$" { APPEND(L"$" L"Log$"); goto loop; }
"$" cvsrev value "$" { APPEND(L"$" L"Revision$"); goto loop; }
"$" cvssrc value "$" { APPEND(L"$" L"Source$"); goto loop; }
any { output[outsize++] = cursor[-1]; if (cursor >= limit) break; goto loop; }
*/
}
output[outsize] = '\0';
// set the new size
*pSize = outsize;
*pbChanged = (insize == outsize) ? 0 : 1;
}

13
samples/C++/simple.re Normal file
View File

@@ -0,0 +1,13 @@
#define NULL ((char*) 0)
char *scan(char *p){
char *q;
#define YYCTYPE char
#define YYCURSOR p
#define YYLIMIT p
#define YYMARKER q
#define YYFILL(n)
/*!re2c
[0-9]+ {return YYCURSOR;}
[\000-\377] {return NULL;}
*/
}

483
samples/Reason/JSX.re Normal file
View File

@@ -0,0 +1,483 @@
type component = {displayName: string};
let module Bar = {
let createElement c::c=? children => {
displayName: "test"
};
};
let module Nesting = {
let createElement children => {
displayName: "test"
};
};
let module Much = {
let createElement children => {
displayName: "test"
};
};
let module Foo = {
let createElement a::a=? b::b=? children => {
displayName: "test"
};
};
let module One = {
let createElement
test::test=?
foo::foo=?
children => {
displayName: "test"
};
let createElementobvioustypo
test::test
children => {
displayName: "test"
};
};
let module Two = {
let createElement foo::foo=? children => {
displayName: "test"
};
};
let module Sibling = {
let createElement
foo::foo=?
(children: list component) => {
displayName: "test"
};
};
let module Test = {
let createElement yo::yo=? children => {
displayName: "test"
};
};
let module So = {
let createElement children => {
displayName: "test"
};
};
let module Foo2 = {
let createElement children => {
displayName: "test"
};
};
let module Text = {
let createElement children => {
displayName: "test"
};
};
let module Exp = {
let createElement children => {
displayName: "test"
};
};
let module Pun = {
let createElement intended::intended=? children => {
displayName: "test"
};
};
let module Namespace = {
let module Foo = {
let createElement
intended::intended=?
anotherOptional::x=100
children => {
displayName: "test"
};
};
};
let module LotsOfArguments = {
let createElement
argument1::argument1=?
argument2::argument2=?
argument3::argument3=?
argument4::argument4=?
argument5::argument5=?
argument6::argument6=?
children => {
displayName: "test"
};
};
let div argument1::argument1=? children => {
displayName: "test"
};
let module List1 = {
let createElement children => {
displayName: "test"
};
};
let module List2 = {
let createElement children => {
displayName: "test"
};
};
let module List3 = {
let createElement children => {
displayName: "test"
};
};
let (/><) a b => a + b;
let (><) a b => a + b;
let (/>) a b => a + b;
let (><\/) a b => a + b;
let tag1 = 5 />< 6;
let tag2 = 5 >< 7;
let tag3 = 5 /> 7;
let tag4 = 5 ><\/ 7;
let b = 2;
let selfClosing = <Foo />;
let selfClosing2 = <Foo a=1 b=true />;
let selfClosing3 =
<Foo
a="really long values that should"
b="cause the entire thing to wrap"
/>;
let a = <Foo> <Bar c=(fun a => a + 2) /> </Foo>;
let a3 = <So> <Much> <Nesting /> </Much> </So>;
let a4 =
<Sibling>
<One test=true foo=b />
<Two foo=b />
</Sibling>;
let a5 = <Foo> "testing a string here" </Foo>;
let a6 =
<Foo2>
<Text> "testing a string here" </Text>
<Test yo=1 />
<Text> "another string" </Text>
<Bar />
<Exp> (2 + 4) </Exp>
</Foo2>;
let intended = true;
let punning = <Pun intended />;
let namespace = <Namespace.Foo />;
let c = <Foo />;
let d = <Foo />;
let spaceBefore =
<So> <Much> <Nesting /> </Much> </So>;
let spaceBefore2 = <So> <Much /> </So>;
let siblingNotSpaced =
<So> <Much /> <Much /> </So>;
let jsxInList = [<Foo />];
let jsxInList2 = [<Foo />];
let jsxInListA = [<Foo />];
let jsxInListB = [<Foo />];
let jsxInListC = [<Foo />];
let jsxInListD = [<Foo />];
let jsxInList3 = [<Foo />, <Foo />, <Foo />];
let jsxInList4 = [<Foo />, <Foo />, <Foo />];
let jsxInList5 = [<Foo />, <Foo />];
let jsxInList6 = [<Foo />, <Foo />];
let jsxInList7 = [<Foo />, <Foo />];
let jsxInList8 = [<Foo />, <Foo />];
let testFunc b => b;
let jsxInFnCall = testFunc <Foo />;
let lotsOfArguments =
<LotsOfArguments
argument1=1
argument2=2
argument3=3
argument4=4
argument5=5
argument6="test">
<Namespace.Foo />
</LotsOfArguments>;
let lowerCase = <div argument1=1 />;
let b = 0;
let d = 0;
/*
* Should pun the first example:
*/
let a = <Foo a> 5 </Foo>;
let a = <Foo a=b> 5 </Foo>;
let a = <Foo a=b b=d> 5 </Foo>;
let a = <Foo a> 0.55 </Foo>;
let a = Foo.createElement "" [@JSX];
let ident = <Foo> a </Foo>;
let fragment1 = <> <Foo /> <Foo /> </>;
let fragment2 = <> <Foo /> <Foo /> </>;
let fragment3 = <> <Foo /> <Foo /> </>;
let fragment4 = <> <Foo /> <Foo /> </>;
let fragment5 = <> <Foo /> <Foo /> </>;
let fragment6 = <> <Foo /> <Foo /> </>;
let fragment7 = <> <Foo /> <Foo /> </>;
let fragment8 = <> <Foo /> <Foo /> </>;
let fragment9 = <> 2 2 2 2 </>;
let fragment10 = <> 2.2 3.2 4.6 1.2 </>;
let fragment11 = <> "str" </>;
let fragment12 = <> (6 + 2) (6 + 2) (6 + 2) </>;
let fragment13 = <> fragment11 fragment11 </>;
let listOfItems1 = <List1> 1 2 3 4 5 </List1>;
let listOfItems2 =
<List2> 1.0 2.8 3.8 4.0 5.1 </List2>;
let listOfItems3 =
<List3> fragment11 fragment11 </List3>;
/*
* Several sequential simple jsx expressions must be separated with a space.
*/
let thisIsRight a b => ();
let tagOne children => ();
let tagTwo children => ();
/* thisIsWrong <tagOne /><tagTwo />; */
thisIsRight <tagOne /> <tagTwo />;
/* thisIsWrong <tagOne> </tagOne><tagTwo> </tagTwo>; */
thisIsRight <tagOne /> <tagTwo />;
let a children => ();
let b children => ();
let thisIsOkay =
<List1> <a /> <b /> <a /> <b /> </List1>;
let thisIsAlsoOkay =
<List1> <a /> <b /> </List1>;
/* Doesn't make any sense, but suppose you defined an
infix operator to compare jsx */
<a /> < <b />;
<a /> > <b />;
<a /> < <b />;
<a /> > <b />;
let listOfListOfJsx = [<> </>];
let listOfListOfJsx = [<> <Foo /> </>];
let listOfListOfJsx = [
<> <Foo /> </>,
<> <Bar /> </>
];
let listOfListOfJsx = [
<> <Foo /> </>,
<> <Bar /> </>,
...listOfListOfJsx
];
let sameButWithSpaces = [<> </>];
let sameButWithSpaces = [<> <Foo /> </>];
let sameButWithSpaces = [
<> <Foo /> </>,
<> <Bar /> </>
];
let sameButWithSpaces = [
<> <Foo /> </>,
<> <Bar /> </>,
...sameButWithSpaces
];
/*
* Test named tag right next to an open bracket.
*/
let listOfJsx = [];
let listOfJsx = [<Foo />];
let listOfJsx = [<Foo />, <Bar />];
let listOfJsx = [<Foo />, <Bar />, ...listOfJsx];
let sameButWithSpaces = [];
let sameButWithSpaces = [<Foo />];
let sameButWithSpaces = [<Foo />, <Bar />];
let sameButWithSpaces = [
<Foo />,
<Bar />,
...sameButWithSpaces
];
/**
* Test no conflict with polymorphic variant types.
*/
type thisType = [ | `Foo | `Bar];
type t 'a = [< thisType] as 'a;
let asd =
<One test=true foo=2> "a" "b" </One> [@foo];
let asd2 =
One.createElementobvioustypo
test::false
["a", "b"]
[@JSX]
[@foo];
let span
test::(test: bool)
foo::(foo: int)
children => 1;
let asd =
<span test=true foo=2> "a" "b" </span> [@foo];
/* "video" call doesn't end with a list, so the expression isn't converted to JSX */
let video test::(test: bool) children => children;
let asd2 = video test::false 10 [@JSX] [@foo];
let div children => 1;
((fun () => div) ()) [] [@JSX];
let myFun () =>
<>
<Namespace.Foo
intended=true
anotherOptional=200
/>
<Namespace.Foo
intended=true
anotherOptional=200
/>
<Namespace.Foo
intended=true anotherOptional=200>
<Foo />
<Foo />
<Foo />
<Foo />
<Foo />
<Foo />
<Foo />
</Namespace.Foo>
</>;
let myFun () => <> </>;
let myFun () =>
<>
<Namespace.Foo
intended=true
anotherOptional=200
/>
<Namespace.Foo
intended=true
anotherOptional=200
/>
<Namespace.Foo
intended=true anotherOptional=200>
<Foo />
<Foo />
<Foo />
<Foo />
<Foo />
<Foo />
<Foo />
</Namespace.Foo>
</>;
/**
* Children should wrap without forcing attributes to.
*/
<Foo a=10 b=0>
<Bar />
<Bar />
<Bar />
<Bar />
</Foo>;
/**
* Failing test cases:
*/
/* let res = <Foo a=10 b=(<Foo a=200 />) > */
/* <Bar /> */
/* </Foo>; */
/* let res = <Foo a=10 b=(<Foo a=200 />) />; */

1326
samples/Reason/Layout.re Normal file

File diff suppressed because it is too large Load Diff

344
samples/Reason/Machine.re Normal file
View File

@@ -0,0 +1,344 @@
open Format;
let module Endo = {
type t 'a = 'a => 'a;
};
let module Syntax = {
let module Var = {
type t = int;
};
let module Term = {
type t =
| App t t
| Lam t
| Var Var.t
;
};
let module Sub = {
type t 'a =
| Cmp (t 'a) (t 'a)
| Dot 'a (t 'a)
| Id
| Shift
;
let map f sgm => {
let rec go = fun
| Cmp sgm0 sgm1 => Cmp (go sgm0) (go sgm1)
| Dot a sgm => Dot (f a) (go sgm)
| Id => Id
| Shift => Shift
;
go sgm;
};
let rec apply sgm e =>
switch (sgm, e) {
| (sgm, Term.App e0 e1) => Term.App (apply sgm e0) (apply sgm e1)
| (sgm, Term.Lam e) => Term.Lam (apply (Dot (Term.Var 0) (Cmp sgm Shift)) e)
| (Dot e _, Term.Var 0) => e
| (Dot _ sgm, Term.Var i) => apply sgm (Term.Var (i - 1))
| (Id, Term.Var i) => Term.Var i
| (Shift, Term.Var i) => Term.Var (i + 1)
| (Cmp rho sgm, e) => apply sgm (apply rho e)
};
};
};
let module Zip = {
open Syntax;
type t 'a =
| App0 (t 'a) 'a
| App1 'a (t 'a)
| Halt
| Lam (t 'a)
;
let map f sgm => {
let rec go = fun
| App0 zip e1 => App0 (go zip) (f e1)
| App1 e0 zip => App1 (f e0) (go zip)
| Halt => Halt
| Lam zip => Lam (go zip)
;
go sgm;
};
let rec apply zip acc => switch zip {
| App0 zip e1 => apply zip (Term.App acc e1)
| App1 e0 zip => apply zip (Term.App e0 acc)
| Halt => acc
| Lam zip => apply zip (Term.Lam acc)
};
};
let module Clo = {
open Syntax;
type t =
| Clo Term.t (Sub.t t);
let rec from (Clo term sgm) => Sub.apply (Sub.map from sgm) term;
};
let module Pretty = {
let module Delim = {
type t = string;
let pp prev next fmt token => if (prev < next) { fprintf fmt "%s" token };
};
let module Prec = {
type t = int;
open Syntax.Term;
let calc = fun
| App _ _ => 1
| Lam _ => 2
| Var _ => 0
;
};
let module Name = {
type t = string;
let suffix = {
let script = fun
| 0 => ""
| 1 => ""
| 2 => ""
| 3 => ""
| 4 => ""
| 5 => ""
| 6 => ""
| 7 => ""
| 8 => ""
| 9 => ""
| _ => failwith "bad subscript";
let rec go acc => fun
| 0 => acc
| n => go (script (n mod 10) ^ acc) (n / 10);
go ""
};
let gen = {
let offset = 97;
let width = 26;
fun () i => {
let code = i mod width + offset;
let char = Char.chr code;
let prime = i / width;
let suffix = suffix prime;
let name = Char.escaped char ^ suffix;
Some name;
}
};
};
let module Env = {
type t = {
used: list Name.t,
rest: Stream.t Name.t,
};
let mk () => {
let used = [];
let rest = Stream.from @@ Name.gen ();
{ used, rest };
};
};
type printer 'a = Env.t => Prec.t => formatter => 'a => unit;
let module Term = {
open Syntax.Term;
let rec pp ({ Env.used: used, rest } as env) prev fmt e => {
let next = Prec.calc e;
switch e {
| App e0 e1 =>
fprintf fmt "@[%a%a@ %a%a@]"
(Delim.pp prev next) "("
(pp env 1) e0
(pp env 0) e1
(Delim.pp prev next) ")"
| Lam e =>
let name = Stream.next rest;
let env = { ...env, Env.used: [name, ...used] };
fprintf fmt "%aλ%a.%a%a"
(Delim.pp prev next) "("
(pp_print_string) name
(pp env next) e
(Delim.pp prev next) ")"
| Var index =>
fprintf fmt "%s" @@ try (List.nth used index) {
| _ => "#" ^ string_of_int index
}
}
};
};
let module Sub = {
open Syntax.Sub;
let rec pp pp_elem env prev fmt => fun
| Cmp sgm1 sgm0 =>
fprintf fmt "@[%a;@ %a@]"
(pp pp_elem env prev) sgm1
(pp pp_elem env prev) sgm0
| Dot e sgm =>
fprintf fmt "@[%a@ ·@ %a@]"
(pp_elem env prev) e
(pp pp_elem env prev) sgm
| Id =>
fprintf fmt "ι"
| Shift =>
fprintf fmt ""
;
};
let module Clo = {
let rec pp env prev fmt (Clo.Clo e sgm) => {
let next = Prec.calc e;
fprintf fmt "@[%a%a%a[%a]@]"
(Delim.pp prev next) "("
(Term.pp env next) e
(Delim.pp prev next) ")"
(Sub.pp pp env next) sgm
};
};
let module Zip = {
open Zip;
let rec pp pp_elem env prev fmt => fun
| App0 zip elem =>
fprintf fmt "inl@[<v -1>⟨@,%a@,%a⟩@]"
(pp pp_elem env prev) zip
(pp_elem env prev) elem
| App1 elem zip =>
fprintf fmt "inr@[<v -1>⟨@,%a@,%a⟩@]"
(pp_elem env prev) elem
(pp pp_elem env prev) zip
| Halt =>
fprintf fmt "halt"
| Lam zip =>
fprintf fmt "lam@[<v -1>⟨@,%a⟩@]"
(pp pp_elem env prev) zip
;
};
};
let module Machine = {
type t = {
clo: Clo.t,
ctx: Zip.t Clo.t,
};
let into e => {
open Clo;
open Syntax.Sub;
let clo = Clo e Id;
let ctx = Zip.Halt;
{ clo, ctx }
};
let from { clo, ctx } => Zip.apply (Zip.map Clo.from ctx) (Clo.from clo);
let pp fmt rule state => {
fprintf fmt "@[<v>ctx ::@[<v -5>@,%a@]@,clo ::@[<v -5>@,%a@]@,rule ::@[<v -5>@,%a@]@,term ::@[<v -5>@,%a@]@]@."
(Pretty.Zip.pp Pretty.Clo.pp (Pretty.Env.mk ()) 2) state.ctx
(Pretty.Clo.pp (Pretty.Env.mk ()) 2) state.clo
(pp_print_string) rule
(Pretty.Term.pp (Pretty.Env.mk ()) 2) (from state)
};
let halted state => {
open Clo;
open Syntax.Sub;
open Syntax.Term;
switch state {
| { clo: Clo (Var _) Id, _ } => true
| _ => false
} [@warning "-4"];
};
let step state => {
open Clo;
open Syntax.Sub;
open Syntax.Term;
let rule = ref "";
let state = switch state {
/* left */
| { clo: Clo (App e0 e1) sgm, ctx } =>
let clo = Clo e0 sgm;
let ctx = Zip.App0 ctx (Clo e1 sgm);
rule := "LEFT";
{ clo, ctx };
/* beta */
| { clo: Clo (Lam e) sgm, ctx: Zip.App0 ctx c0 } =>
let clo = Clo e (Cmp (Dot c0 sgm) Id);
rule := "BETA";
{ clo, ctx };
/* lambda */
| { clo: Clo (Lam e) sgm, ctx } =>
let clo = Clo e (Cmp (Dot (Clo (Var 0) Id) (Cmp sgm Shift)) Id);
let ctx = Zip.Lam ctx;
rule := "LAMBDA";
{ clo, ctx };
/* associate */
| { clo: Clo (Var n) (Cmp (Cmp pi rho) sgm), ctx } =>
let clo = Clo (Var n) (Cmp pi (Cmp rho sgm));
rule := "ASSOCIATE";
{ clo, ctx };
/* head */
| { clo: Clo (Var 0) (Cmp (Dot (Clo e pi) _) sgm), ctx } =>
let clo = Clo e (Cmp pi sgm);
rule := "HEAD";
{ clo, ctx };
/* tail */
| { clo: Clo (Var n) (Cmp (Dot (Clo _ _) rho) sgm), ctx } =>
let clo = Clo (Var (n - 1)) (Cmp rho sgm);
rule := "TAIL";
{ clo, ctx };
/* shift */
| { clo: Clo (Var n) (Cmp Shift sgm), ctx } =>
let clo = Clo (Var (n + 1)) sgm;
rule := "SHIFT";
{ clo, ctx };
/* id */
| { clo: Clo (Var n) (Cmp Id sgm), ctx } =>
let clo = Clo (Var n) sgm;
rule := "ID";
{ clo, ctx };
| _ =>
pp std_formatter !rule state;
failwith "bad state";
} [@warning "-4"];
pp std_formatter !rule state;
state;
};
let norm e => {
let count = ref 0;
let state = ref (into e);
while (not (halted !state)) {
fprintf std_formatter "@\n--- step[%d] ---@\n" !count;
incr count;
state := step !state;
};
from !state;
};
};
let module Test = {
open Syntax.Term;
let l e => Lam e;
let ( *@ ) e0 e1 => App e0 e1;
let ff = l (l (Var 1));
let tt = l (l (Var 0));
let zero = l (l (Var 1));
let succ = l (l (l (Var 0 *@ Var 2)));
let one = succ *@ zero;
let two = succ *@ one;
let three = succ *@ two;
let const = l (l (Var 1));
let fix = l (l (Var 1 *@ (Var 0 *@ Var 0)) *@ l (Var 1 *@ (Var 0 *@ Var 0)));
let add = fix *@ l (l (l (Var 1 *@ Var 0 *@ l (succ *@ Var 3 *@ Var 0 *@ Var 1))));
let init = l (l (Var 0) *@ l (l (Var 1)));
};
let module Run = {
let go () => Machine.norm Test.init;
};

View File

@@ -0,0 +1,308 @@
/*
* Copyright (c) 2015-present, Facebook, Inc.
* All rights reserved.
*
*/
let startedMerlin: ref (option Js.Unsafe.any) = {contents: None};
let fixedEnv = Js.Unsafe.js_expr "require('../lib/fixedEnv')";
/* This and the subsequent big js blocks are copied over from Nuclide. More convenient for now. */
let findNearestMerlinFile' = Js.Unsafe.js_expr {|
function findNearestMerlinFile(beginAtFilePath) {
var path = require('path');
var fs = require('fs');
var fileDir = path.dirname(beginAtFilePath);
var currentPath = path.resolve(fileDir);
do {
var fileToFind = path.join(currentPath, '.merlin');
var hasFile = fs.existsSync(fileToFind);
if (hasFile) {
return path.dirname(currentPath);
}
if (path.dirname(currentPath) === currentPath) {
// Bail
return '.';
}
currentPath = path.dirname(currentPath);
} while (true);
}
|};
let findNearestMerlinFile beginAtFilePath::path => {
let result = Js.Unsafe.fun_call findNearestMerlinFile' [|Js.Unsafe.inject (Js.string path)|];
Js.to_string result
};
let createMerlinReaderFnOnce' = Js.Unsafe.js_expr {|
function(ocamlMerlinPath, ocamlMerlinFlags, dotMerlinDir, fixedEnv) {
var spawn = require('child_process').spawn;
// To split while stripping out any leading/trailing space, we match on all
// *non*-whitespace.
var items = ocamlMerlinFlags === '' ? [] : ocamlMerlinFlags.split(/\s+/);
var merlinProcess = spawn(ocamlMerlinPath, items, {cwd: dotMerlinDir});
merlinProcess.stderr.on('data', function(d) {
console.error('Ocamlmerlin: something wrong happened:');
console.error(d.toString());
});
merlinProcess.stdout.on('close', function(d) {
console.error('Ocamlmerlin: closed.');
});
var cmdQueue = [];
var hasStartedReading = false;
var readline = require('readline');
var reader = readline.createInterface({
input: merlinProcess.stdout,
terminal: false,
});
return function(cmd, resolve, reject) {
cmdQueue.push([resolve, reject]);
if (!hasStartedReading) {
hasStartedReading = true;
reader.on('line', function(line) {
var response;
try {
response = JSON.parse(line);
} catch (err) {
response = null;
}
var resolveReject = cmdQueue.shift();
var resolve = resolveReject[0];
var reject = resolveReject[1];
if (!response || !Array.isArray(response) || response.length !== 2) {
reject(new Error('Unexpected ocamlmerlin output format: ' + line));
return;
}
var status = response[0];
var content = response[1];
var errorResponses = {
'failure': true,
'error': true,
'exception': true,
};
if (errorResponses[status]) {
reject(new Error('Ocamlmerlin returned an error: ' + line));
return;
}
resolve(content);
});
}
merlinProcess.stdin.write(JSON.stringify(cmd));
};
}
|};
let createMerlinReaderFnOnce
pathToMerlin::pathToMerlin
merlinFlags::merlinFlags
dotMerlinPath::dotMerlinPath =>
Js.Unsafe.fun_call
createMerlinReaderFnOnce'
[|
Js.Unsafe.inject (Js.string pathToMerlin),
Js.Unsafe.inject (Js.string merlinFlags),
Js.Unsafe.inject (Js.string dotMerlinPath),
Js.Unsafe.inject fixedEnv
|];
let startMerlinProcess path::path =>
switch startedMerlin.contents {
| Some readerFn => ()
| None =>
let atomReasonPathToMerlin = Atom.Config.get "atom-reason.pathToMerlin";
let atomReasonMerlinFlags = Atom.Config.get "atom-reason.merlinFlags";
let atomReasonMerlinLogFile = Atom.Config.get "atom-reason.merlinLogFile";
switch atomReasonMerlinLogFile {
| JsonString "" => ()
| JsonString s => Atom.Env.setEnvVar "MERLIN_LOG" s
| _ => ()
};
let readerFn =
createMerlinReaderFnOnce
pathToMerlin::(Atom.JsonValue.unsafeExtractString atomReasonPathToMerlin)
merlinFlags::(Atom.JsonValue.unsafeExtractString atomReasonMerlinFlags)
dotMerlinPath::(findNearestMerlinFile beginAtFilePath::path);
startedMerlin.contents = Some readerFn
};
let readOneLine cmd::cmd resolve reject =>
switch startedMerlin.contents {
| None => raise Not_found
| Some readerFn =>
Js.Unsafe.fun_call
readerFn
[|
Js.Unsafe.inject cmd,
Js.Unsafe.inject (Js.wrap_callback resolve),
Js.Unsafe.inject (Js.wrap_callback reject)
|]
};
/* contextify is important for avoiding different buffers calling the backing merlin at the same time. */
/* https://github.com/the-lambda-church/merlin/blob/d98a08d318ca14d9c702bbd6eeadbb762d325ce7/doc/dev/PROTOCOL.md#contextual-commands */
let contextify query::query path::path => Js.Unsafe.obj [|
("query", Js.Unsafe.inject query),
("context", Js.Unsafe.inject (Js.array [|Js.string "auto", Js.string path|]))
|];
let prepareCommand text::text path::path query::query resolve reject => {
startMerlinProcess path;
/* These two commands should be run before every main command. */
readOneLine
cmd::(
contextify
/* The protocol command tells Merlin which API version we want to use. (2 for us) */
query::(
Js.array [|
Js.Unsafe.inject (Js.string "protocol"),
Js.Unsafe.inject (Js.string "version"),
Js.Unsafe.inject (Js.number_of_float 2.)
|]
)
path::path
)
(
fun _ =>
readOneLine
cmd::(
contextify
/* The tell command allows us to synchronize our text with Merlin's internal buffer. */
query::(
Js.array [|Js.string "tell", Js.string "start", Js.string "end", Js.string text|]
)
path::path
)
(fun _ => readOneLine cmd::(contextify query::query path::path) resolve reject)
reject
)
reject
};
let positionToJsMerlinPosition (line, col) => Js.Unsafe.obj [|
/* lines (rows) are 1-based for merlin, not 0-based, like for Atom */
("line", Js.Unsafe.inject (Js.number_of_float (float_of_int (line + 1)))),
("col", Js.Unsafe.inject (Js.number_of_float (float_of_int col)))
|];
/* Actual merlin commands we'll use. */
let getTypeHint path::path text::text position::position resolve reject =>
prepareCommand
text::text
path::path
query::(
Js.array [|
Js.Unsafe.inject (Js.string "type"),
Js.Unsafe.inject (Js.string "enclosing"),
Js.Unsafe.inject (Js.string "at"),
Js.Unsafe.inject (positionToJsMerlinPosition position)
|]
)
resolve
reject;
let getAutoCompleteSuggestions
path::path
text::text
position::position
prefix::prefix
resolve
reject =>
prepareCommand
text::text
path::path
query::(
Js.array [|
Js.Unsafe.inject (Js.string "complete"),
Js.Unsafe.inject (Js.string "prefix"),
Js.Unsafe.inject (Js.string prefix),
Js.Unsafe.inject (Js.string "at"),
Js.Unsafe.inject (positionToJsMerlinPosition position),
Js.Unsafe.inject (Js.string "with"),
Js.Unsafe.inject (Js.string "doc")
|]
)
resolve
reject;
let getDiagnostics path::path text::text resolve reject =>
prepareCommand
text::text
path::path
query::(Js.array [|Js.Unsafe.inject (Js.string "errors")|])
resolve
reject;
let locate path::path text::text extension::extension position::position resolve reject =>
prepareCommand
text::text
path::path
query::(
Js.array [|
Js.Unsafe.inject (Js.string "locate"),
Js.Unsafe.inject (Js.string ""),
Js.Unsafe.inject (Js.string extension),
Js.Unsafe.inject (Js.string "at"),
Js.Unsafe.inject (positionToJsMerlinPosition position)
|]
)
resolve
reject;
/* reject */
let getOccurrences path::path text::text position::position resolve reject =>
prepareCommand
text::text
path::path
query::(
Js.array [|
Js.Unsafe.inject (Js.string "occurrences"),
Js.Unsafe.inject (Js.string "ident"),
Js.Unsafe.inject (Js.string "at"),
Js.Unsafe.inject (positionToJsMerlinPosition position)
|]
)
resolve
reject;
let destruct
path::path
text::text
startPosition::startPosition
endPosition::endPosition
resolve
reject =>
prepareCommand
text::text
path::path
query::(
Js.array [|
Js.Unsafe.inject (Js.string "case"),
Js.Unsafe.inject (Js.string "analysis"),
Js.Unsafe.inject (Js.string "from"),
Js.Unsafe.inject (positionToJsMerlinPosition startPosition),
Js.Unsafe.inject (Js.string "to"),
Js.Unsafe.inject (positionToJsMerlinPosition endPosition)
|]
)
resolve
reject;
let getOutline path::path text::text resolve reject =>
prepareCommand
text::text
path::path
query::(Js.array [|Js.Unsafe.inject (Js.string "outline")|])
resolve
reject;

989
samples/Reason/Syntax.re Normal file
View File

@@ -0,0 +1,989 @@
/* Copyright (c) 2015-present, Facebook, Inc. All rights reserved. */
[@@@autoFormat let wrap = 80; let shift = 2];
Modules.run ();
Polymorphism.run ();
Variants.run ();
BasicStructures.run ();
TestUtils.printSection "General Syntax";
/* Won't work! */
/* let matchingFunc a = match a with */
/* `Thingy x => (print_string "matched thingy x"); x */
/* | `Other x => (print_string "matched other x"); x;; */
/* */
let matchingFunc a =>
switch a {
| `Thingy x =>
print_string "matched thingy x";
let zz = 10;
zz
| `Other x =>
print_string "matched other x";
x
};
type firstTwoShouldBeGroupedInParens =
(int => int) => int => int;
type allParensCanBeRemoved =
int => int => int => int;
type firstTwoShouldBeGroupedAndFirstThree =
((int => int) => int) => int;
/* Same thing now but with type constructors instead of each int */
type firstTwoShouldBeGroupedInParens =
(list int => list int) => list int => list int;
type allParensCanBeRemoved =
list int => list int => list int => list int;
type firstTwoShouldBeGroupedAndFirstThree =
((list int => list int) => list int) =>
list int;
type myRecordType = {
firstTwoShouldBeGroupedInParens:
(int => int) => int => int,
allParensCanBeRemoved:
int => int => int => int,
firstTwoShouldBeGroupedAndFirstThree:
((int => int) => int) => int
};
type firstNamedArgShouldBeGroupedInParens =
first::(int => int) => second::int => int;
type allParensCanBeRemoved =
first::int => second::int => third::int => int;
type firstTwoShouldBeGroupedAndFirstThree =
first::((int => int) => int) => int;
/* Same thing now, but with type constructors instead of int */
type firstNamedArgShouldBeGroupedInParens =
first::(list int => list int) =>
second::list int =>
list int;
type allParensCanBeRemoved =
first::list int =>
second::list int =>
third::list int =>
list int;
type firstTwoShouldBeGroupedAndFirstThree =
first::((list int => list int) => list int) =>
list int;
type firstNamedArgShouldBeGroupedInParens =
first::(int => int)? =>
second::int list? =>
int;
/* The arrow necessitates parens around the next two args. The ? isn't what
* makes the parens necessary. */
type firstNamedArgShouldBeGroupedInParensAndSecondNamedArg =
first::(int => int)? =>
second::(int => int)? =>
int;
type allParensCanBeRemoved =
first::int? =>
second::int? =>
third::int? =>
int;
type firstTwoShouldBeGroupedAndFirstThree =
first::((int => int) => int) => int;
type noParens =
one::int => int => int => two::int => int;
type noParensNeeded =
one::int => int => int => two::int => int;
type firstNamedArgNeedsParens =
one::(int => int => int) => two::int => int;
/* Now, let's try type aliasing */
/* Unless wrapped in parens, types between arrows may not be aliased, may not
* themselves be arrows. */
type parensRequiredAroundFirstArg =
(list int as 'a) => int as 'a;
type parensRequiredAroundReturnType =
(list int as 'a) => (int as 'a);
type parensRequiredAroundReturnType =
(list int as 'a) => (int as 'a) as 'b;
type noParensNeededWhenInTuple =
(list int as 'a, list int as 'b) as 'entireThing;
type myTypeDef 'a = list 'a;
type instatiatedTypeDef = myTypeDef int => int;
/* Test a type attribute for good measure */
/* We should clean up all of the attribute tagging eventually, but for now,
* let's make it super ugly to get out of the way of all the formatting/parsing
* implementations (fewer conflicts during parsing, fewer edge cases during
* printing).
*/
type something = (
int,
int [@lookAtThisAttribute]
);
type longWrappingTypeDefinitionExample =
M_RK__G.Types.instance
(TGRecognizer.tGFields unit unit)
(TGRecognizer.tGMethods unit unit);
type semiLongWrappingTypeDefinitionExample =
M_RK__Gesture.Types.instance
TGRecognizerFinal.tGFields
TGRecognizerFinal.tGMethods;
type semiLongWrappingTypeWithConstraint =
M_RK__Gesture.Types.instance
'a
TGRecognizerFinal.tGFields
TGRecognizerFinal.tGMethods
constraint 'a = (unit, unit);
type onelineConstrain = 'a constraint 'a = int;
/* This must be in trunk but not in this branch of OCaml */
/* type withNestedRecords = MyConstructor {myField: int} */
type colors =
| Red int
| Black int
| Green int;
/* Another approach is to require declared variants to wrap any record */
/* type myRecord = MyRecord {name: int}; */
/* let myValue = MyRecord {name: int}; */
/* This would force importing of the module */
/* This would also lend itself naturally to pattern matching - and avoid having
to use `.` operator at all since you normally destructure. */
type nameBlahType = {nameBlah: int};
let myRecord = {nameBlah: 20};
let myRecordName = myRecord.nameBlah;
let {nameBlah}: nameBlahType = {nameBlah: 20};
print_int nameBlah;
let {nameBlah: aliasedToThisVar}: nameBlahType = {
nameBlah: 20
};
print_int aliasedToThisVar;
let desiredFormattingForWrappedLambda:
int => int => int => nameBlahType =
/*
fun is
pre- /firstarg\
fix /-coupled--\
|-\ /-to-prefix--\ */
fun curriedArg anotherArg lastArg => {
nameBlah: 10
};
type longerInt = int;
let desiredFormattingForWrappedLambdaWrappedArrow:
longerInt =>
longerInt =>
longerInt =>
nameBlahType =
/*
fun is
pre- /firstarg\
fix /-coupled--\
|-\ /-to-prefix--\ */
fun curriedArg anotherArg lastArg => {
nameBlah: 10
};
let desiredFormattingForWrappedLambdaReturnOnNewLine
/*
fun is
pre- /firstarg\
fix /-coupled--\
|-\ /-to-prefix--\ */
curriedArg
anotherArg
lastArg => {
nameBlah: 10
};
/*
let is
pre-
fix /-function binding name---\
|-\ / is coupled to prefix \ */
let desiredFormattingForWrappedSugar
curriedArg
anotherArg
lastArg => {
nameBlah: 10
};
/*
let is
pre-
fix /-function binding name---\
|-\ / is coupled to prefix \ */
let desiredFormattingForWrappedSugarReturnOnNewLine
curriedArg
anotherArg
lastArg => {
nameBlah: 10
};
/*
let : type t1 t2. t1 * t2 list -> t1 = ...
let rec f : 't1 't2. 't1 * 't2 list -> 't1 =
fun (type t1) (type t2) -> (... : t1 * t2 list -> t1)
*/
type point = {x: int, y: int};
type point3D = {x: int, y: int, z: int};
let point2D = {x: 20, y: 30};
let point3D: point3D = {
x: 10,
y: 11,
z: 80 /* Optional Comma */
};
let printPoint (p: point) => {
print_int p.x;
print_int p.y
};
let addPoints (p1: point, p2: point) => {
x: p1.x + p2.x,
y: p1.y + p2.y
};
let res1 = printPoint point2D;
let res2 =
printPoint {x: point3D.x, y: point3D.y};
/*
When () were used to indicate sequences, the parser used seq_expr not only
for grouping sequences, but also to form standard precedences.
/------- sequence_expr ------\
let res3 = printPoint (addPoints (point2D, point3D));
Interestingly, it knew that tuples aren't sequences.
To move towards semi delimited, semi-terminated, braces-grouped sequences:
while allowing any non-sequence expression to be grouped on parens, we make
an explicit rule that allows one single non-semi ended expression to be
grouped in parens.
Actually: We will allow an arbitrary number of semi-delimited expressions to
be wrapped in parens, but the braces grouped semi delimited (sequence)
expressions must *also* be terminated with a semicolon.
This allows the parser to distinguish between
let x = {a}; /* Record {a:a} */
let x = {a;}; /* Single item sequence returning identifier {a} */
*/
let res3 =
printPoint (
addPoints (
point2D,
{x: point3D.x, y: point3D.y}
)
);
type person = {age: int, name: string};
type hiredPerson = {
age: string,
name: string,
dateHired: int
};
let o: person = {name: "bob", age: 10};
/* Parens needed? Nope! */
let o: person = {name: "bob", age: 10};
let printPerson (p: person) => {
let q: person = p;
p.name ^ p.name
};
/* let dontParseMeBro x y:int = x = y;*/
/* With this unification, anywhere eyou see `= fun` you can just ommit it */
let blah a => a; /* Done */
let blah a => a; /* Done (almost) */
let blah a b => a; /* Done */
let blah a b => a; /* Done (almost) */
/* More than one consecutive pattern must have a single case */
type blah = {blahBlah: int};
let blah a {blahBlah} => a;
let blah a {blahBlah} => a;
let module TryToExportTwice = {
let myVal = "hello";
};
/*
Unifying top level module syntax with local module syntax is probably a bad
idea at the moment because it makes it more difficult to continue to support
`let .. in` bindings. We can distinguish local modules for `let..in` that
just happen to be defined at the top level (but not exported).
let MyModule = {let myVal = 20;} in
MyModule.x
Wait, where would this ever be valid, even if we continued to support
`let..in`?
*/
let onlyDoingThisTopLevelLetToBypassTopLevelSequence = {
let x = {
print_int 1;
print_int 20 /* Missing trailing SEMI */
};
let x = {
print_int 1;
print_int 20; /* Ensure missing middle SEMI reported well */
print_int 20
};
let x = {
print_int 1;
print_int 20;
10
/* Comment in final position */
}; /* Missing final SEMI */
x + x
};
type hasA = {a: int};
let a = 10;
let returnsASequenceExpressionWithASingleIdentifier
() => a;
let thisReturnsA () => a;
let thisReturnsAAsWell () => a;
let recordVal: int = (thisReturnsARecord ()).a;
Printf.printf
"\nproof that thisReturnsARecord: %n\n"
recordVal;
Printf.printf
"\nproof that thisReturnsA: %n\n"
(thisReturnsA ());
/* Pattern matching */
let blah arg =>
switch arg {
/* Comment before Bar */
| /* Comment between bar/pattern */ Red _ => 1
/* Comment Before non-first bar */
| /* Comment betwen bar/pattern */ Black _ => 0
| Green _ => 0
};
/* Any function that pattern matches a multicase match is interpretted as a
* single arg that is then matched on. Instead of the above `blah` example:*/
let blah =
fun
| Red _ => 1
| Black _ => 0
| Green _ => 1;
/* `fun a => a` is read as "a function that maps a to a". Then the */
/* above example is read: "a function that 'either maps' Red to.. or maps .." */
/* Thc00f564e first bar is read as "either maps" */
/* Curried form is not supported:
let blah x | Red _ => 1 | Black _ => 0;
Theres no sugar rule for dropping => fun, only = fun
*/
/* let blahCurriedX x => fun /* See, nothing says we can drop the => fun */ */
/* |(Red x | Black x | Green x) => 1 /* With some effort, we can ammend the sugar rule that would */ */
/* | Black x => 0 /* Allow us to drop any => fun.. Just need to make pattern matching */ */
/* | Green x => 0; /* Support that */ */
/* */
let blahCurriedX x =>
fun
| Red x
| Black x
| Green x =>
1 /* With some effort, we can ammend the sugar rule that would */
| Black x => 0 /* Allow us to drop any => fun.. Just need to make pattern matching */
| Green x => 0; /* Support that */
let sameThingInLocal = {
let blahCurriedX x =>
fun
| Red x
| Black x
| Green x =>
1 /* With some effort, we can ammend the sugar rule that would */
| Black x => 0 /* Allow us to drop any => fun.. Just need to make pattern matching */
| Green x => 0; /* Support that */
blahCurriedX
};
/* This should be parsed/printed exactly as the previous */
let blahCurriedX x =>
fun
| Red x
| Black x
| Green x => 1
| Black x => 0
| Green x => 0;
/* Any time there are multiple match cases we require a leading BAR */
let v = Red 10;
let Black x | Red x | Green x = v; /* So this NON-function still parses */
/* This doesn't parse, however (and it doesn't in OCaml either):
let | Black x | Red x | Green x = v;
*/
print_int x;
/* Scoping: Let sequences. Familiar syntax for lexical ML style scope and
sequences. */
let res = {
let a = "a starts out as";
{
print_string a;
let a = 20;
print_int a
};
print_string a
};
let res = {
let a = "first its a string";
let a = 20;
print_int a;
print_int a;
print_int a
};
let res = {
let a = "a is always a string";
print_string a;
let b = 30;
print_int b
};
/* let result = LyList.map (fun | [] => true | _ => false) []; */
/* OTHERWISE: You cannot tell if a is the first match case falling through or
* a curried first arg */
/* let blah = fun a | patt => 0 | anotherPatt => 1; */
/* let blah a patt => 0 | anotherPatt => 1; */
/*simple pattern EQUALGREATER expr */
let blah a {blahBlah} => a;
/* match_case */
/* pattern EQUALGREATER expr */
let blah =
fun
| Red _ => 1
| Black _ => 0
| Green _ => 0;
/* Won't work! */
/* let arrowFunc = fun a b => print_string "returning aplusb from arrow"; a + b;; */
let arrowFunc a b => {
print_string "returning aplusb from arrow";
a + b
};
let add a b => {
let extra = {
print_string "adding";
0
};
let anotherExtra = 0;
extra + a + b + anotherExtra
};
print_string (string_of_int (add 4 34));
let dummy _ => 10;
dummy res1;
dummy res2;
dummy res3;
/* Some edge cases */
let myFun firstArg (Red x | Black x | Green x) =>
firstArg + x;
let matchesWithWhen a =>
switch a {
| Red x when 1 > 0 => 10
| Red _ => 10
| Black x => 10
| Green x => 10
};
let matchesWithWhen =
fun
| Red x when 1 > 0 => 10
| Red _ => 10
| Black x => 10
| Green x => 10;
let matchesOne (`Red x) => 10;
/*
Typical OCaml would make you *wrap the functions in parens*! This is because it
can't tell if a semicolon is a sequence operator. Even if we had records use
commas to separate fields,
*/
type adders = {
addTwoNumbers: int => int => int,
addThreeNumbers: int => int => int => int,
addThreeNumbersTupled: (int, int, int) => int
};
let myRecordWithFunctions = {
addTwoNumbers: fun a b => a + b,
addThreeNumbers: fun a b c => a + b + c,
addThreeNumbersTupled: fun (a, b, c) =>
a + b + c
};
let result =
myRecordWithFunctions.addThreeNumbers 10 20 30;
let result =
myRecordWithFunctions.addThreeNumbersTupled (
10,
20,
30
);
let lookTuplesRequireParens = (1, 2);
/* let thisDoesntParse = 1, 2; */
let tupleInsideAParenSequence = {
print_string "look, a tuple inside a sequence";
let x = 10;
(x, x)
};
let tupleInsideALetSequence = {
print_string "look, a tuple inside a sequence";
let x = 10;
(x, x)
};
/* We *require* that function return types be wrapped in
parenthesis. In this example, there's no ambiguity */
let makeIncrementer (delta: int) :(int => int) =>
fun a => a + delta;
/* We could even force that consistency with let bindings - it's allowed
currently but not forced.
*/
let myAnnotatedValBinding: int = 10;
/* Class functions (constructors) and methods are unified in the same way */
class classWithNoArg = {
method x = 0;
method y = 0;
};
/* This parses but doesn't type check
class myClass init => object
method x => init
method y => init
end;
*/
let myFunc (a: int) (b: int) :(int, int) => (
a,
b
);
let myFunc (a: int) (b: int) :list int => [1];
let myFunc (a: int) (b: int) :point => {
x: a,
y: b
};
let myFunc (a: int, b: int) :point => {
x: a,
y: b
};
type myThing = (int, int);
type stillARecord = {name: string, age: int};
/* Rebase latest OCaml to get the following: And fixup
`generalized_constructor_arguments` according to master. */
/* type ('a, 'b) myOtherThing = Leaf {first:'a, second: 'b} | Null; */
type branch 'a 'b = {first: 'a, second: 'b};
type myOtherThing 'a 'b =
| Leaf (branch 'a 'b)
| Null;
type yourThing = myOtherThing int int;
/* Conveniently - this parses exactly how you would intend! No *need* to wrap
in an extra [], but it doesn't hurt */
/* FIXME type lookAtThesePolyVariants = list [`Red] ; */
/* FIXME type bracketsGroupMultipleParamsAndPrecedence = list (list (list [`Red])); */
/* FIXME type youCanWrapExtraIfYouWant = (list [`Red]); */
/* FIXME type hereAreMultiplePolyVariants = list [`Red | `Black]; */
/* FIXME type hereAreMultiplePolyVariantsWithOptionalWrapping = list ([`Red | `Black]); */
/*
/* Proposal: ES6 style lambdas: */
/* Currying */
let lookES6Style = (`Red x) (`Black y) => { };
let lookES6Style (`Red x) (`Black y) => { };
/* Matching the single argument */
let lookES6Style = oneArg => match oneArg with
| `Red x => x
| `Black x => x;
/* The "trick" to currying that we already have is basically the same - we just
* have to reword it a bit:
* From:
* "Any time you see [let x = fun ...] just replace it with [let x ...]"
* To:
* "Any time you see [let x = ... => ] just replace it with [let x ... => ]"
*/
let lookES6Style oneArg => match oneArg with
| `Red x => x
| `Black x => x;
*/
/** Current OCaml Named Arguments. Any aliasing is more than just aliasing!
OCaml allows full on pattern matching of named args. */
/*
A: let named ~a ~b = aa + bb in
B: let namedAlias ~a:aa ~b:bb = aa + bb in
C: let namedAnnot ~(a:int) ~(b:int) = a + b in
D: let namedAliasAnnot ~a:(aa:int) ~b:(bb:int) = aa + bb in
E: let optional ?a ?b = 10 in
F: let optionalAlias ?a:aa ?b:bb = 10 in
G: let optionalAnnot ?(a:int option) ?(b:int option) = 10 in
H: let optionalAliasAnnot ?a:(aa:int option) ?b:(bb:int option) = 10 in
/*
Look! When a default is provided, annotation causes inferred type of argument
to not be "option" since it's automatically destructured (because we know it
will always be available one way or another.)
*/
I: let defOptional ?(a=10) ?(b=10) = 10 in
J: let defOptionalAlias ?a:(aa=10) ?b:(bb=10) = 10 in
K: let defOptionalAnnot ?(a:int=10) ?(b:int=10) = 10 in
\ \
\label_let_pattern opt_default: no longer needed in SugarML
L: let defOptionalAliasAnnot ?a:(aa:int=10) ?b:(bb:int=10) = 10 in
\ \
\let_pattern: still a useful syntactic building block in SugarML
*/
/**
* In Reason, the syntax for named args uses double semicolon, since
* the syntax for lists uses ES6 style [], freeing up the ::.
*/
let a = 10;
let b = 20;
/*A*/
let named a::a b::b => a + b;
type named = a::int => b::int => int;
/*B*/
let namedAlias a::aa b::bb => aa + bb;
let namedAlias a::aa b::bb => aa + bb;
type namedAlias = a::int => b::int => int;
/*C*/
let namedAnnot a::(a: int) b::(b: int) => 20;
/*D*/
let namedAliasAnnot a::(aa: int) b::(bb: int) => 20;
/*E*/
let myOptional a::a=? b::b=? () => 10;
type named = a::int? => b::int? => unit => int;
/*F*/
let optionalAlias a::aa=? b::bb=? () => 10;
/*G*/
let optionalAnnot a::(a: int)=? b::(b: int)=? () => 10;
/*H*/
let optionalAliasAnnot
a::(aa: int)=?
b::(bb: int)=?
() => 10;
/*I: */
let defOptional a::a=10 b::b=10 () => 10;
type named = a::int? => b::int? => unit => int;
/*J*/
let defOptionalAlias a::aa=10 b::bb=10 () => 10;
/*K*/
let defOptionalAnnot
a::(a: int)=10
b::(b: int)=10
() => 10;
/*L*/
let defOptionalAliasAnnot
a::(aa: int)=10
b::(bb: int)=10
() => 10;
/*M: Invoking them - Punned */
let resNotAnnotated = named a::a b::b;
/*N:*/
let resAnnotated: int = named a::a b::b;
/*O: Invoking them */
let resNotAnnotated = named a::a b::b;
/*P: Invoking them */
let resAnnotated: int = named a::a b::b;
/*Q: Here's why "punning" doesn't work! */
/* Is b:: punned with a final non-named arg, or is b:: supplied b as one named arg? */
let b = 20;
let resAnnotated = named a::a b::b;
/*R: Proof that there are no ambiguities with return values being annotated */
let resAnnotated: ty = named a::a b;
/*S: Explicitly passed optionals are a nice way to say "use the default value"*/
let explictlyPassed =
myOptional a::?None b::?None;
/*T: Annotating the return value of the entire function call */
let explictlyPassedAnnotated: int =
myOptional a::?None b::?None;
/*U: Explicitly passing optional with identifier expression */
let a = None;
let explictlyPassed = myOptional a::?a b::?None;
let explictlyPassedAnnotated: int =
myOptional a::?a b::?None;
let nestedLet = {
let _ = 1;
()
};
let nestedLet = {
let _ = 1;
()
};
let nestedLet = {
let _ = 1;
()
};
let nestedLet = {
let _ = 1;
2
};
/*
* Showing many combinations of type annotations and named arguments.
*/
type typeWithNestedNamedArgs =
outerOne::(
innerOne::int => innerTwo::int => int
) =>
outerTwo::int =>
int;
type typeWithNestedOptionalNamedArgs =
outerOne::
(innerOne::int => innerTwo::int => int)? =>
outerTwo::int? =>
int;
type typeWithNestedOptionalNamedArgs =
outerOne::list string? => outerTwo::int? => int;
let x =
callSomeFunction
withArg::10 andOtherArg::wrappedArg;
let res = {
(constraintedSequenceItem: string);
(dontKnowWheYoudWantToActuallyDoThis: string)
};
let res = {
(
butTheyWillBePrintedWithAppropriateSpacing: string
);
(soAsToInstillBestDevelopmentPractices: string)
};
let x = [
(eachItemInListCanBeAnnotated: int),
(typeConstraints: float),
(
tupleConstraints: int,
andNotFunctionInvocations: int
)
];
let x = [
(butWeWillPrint: int),
(themAsSpaceSeparated: float),
(toInfluenceYour: int, developmentHabbits: int)
];
let newRecord = {
...(annotatedSpreadRecord: someRec),
x: y
};
let newRecord = {
...(annotatedSpreadRecord: someRec),
blah: 0,
foo: 1
};
let newRecord = {
...(
youCanEvenCallMethodsHereAndAnnotate them: someRec
),
blah: 0,
foo: 1
};
let newRecord = {
...(
youCanEvenCallMethodsHereAndAnnotate
them named::10: someRec
),
blah: 0,
foo: 1
};
let something: thing blah = aTypeAnnotation;
let something: thing blah = thisIsANamedArg;
let something: thing blah = aTypeAnnotation;
let something: blah = thisIsANamedArg thing;
let something: blah = typeAnnotation thing;
let newRecord = {
...(
heresAFunctionWithNamedArgs argOne::i: annotatedResult
),
soAsToInstill: 0,
developmentHabbits: 1
};
[@@@thisIsAThing];
let x = 10;
/* Ensure that the parenthesis are preserved here because they are
* important:
*/
let something =
fun
| None => (
fun
| [] => "emptyList"
| [_, ..._] => "nonEmptyList"
)
| Some _ => (
fun
| [] => "emptyList"
| [_, ..._] => "nonEmptyList"
);
/* A | B = X; */
let A | B = X;
/* A | (B | C) = X; */
let A | (B | C) = X;
/* (A | B) | (C | D) = X; */
let A | B | (C | D) = X;
/* A | B | (C | D) = X; */
let A | B | (C | D) = X;
/* (A | B) | C = X; */
let A | B | C = X;
/* A | B | C = X; */
let A | B | C = X;
/** External function declaration
*
*/
external f : int => int = "foo";
let x = {contents: 0};
let unitVal = x.contents = 210;

1
vendor/grammars/reason vendored Submodule

Submodule vendor/grammars/reason added at 97d91c61d1

35
vendor/licenses/grammar/reason.txt vendored Normal file
View File

@@ -0,0 +1,35 @@
---
type: grammar
name: reason
license: bsd-3-clause
---
BSD License
For Reason software
Copyright (c) 2015-present, Facebook, Inc. All rights reserved.
Redistribution and use in source and binary forms, with or without modification,
are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright notice, this
list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright notice,
this list of conditions and the following disclaimer in the documentation
and/or other materials provided with the distribution.
* Neither the name Facebook nor the names of its contributors may be used to
endorse or promote products derived from this software without specific
prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.