Initial commit of LIGO tooling

.gitignore

@@ -15,3 +15,17 @@ Version.ml
 *.coverage
 /_coverage/
 /_coverage_*/
+*.gyp
+tools/lsp/pascaligo/package.json
+tools/lsp/pascaligo/node_modules
+tools/lsp/pascaligo/log.html
+tools/lsp/pascaligo/src/
+tools/lsp/pascaligo/index.js
+tools/lsp/pascaligo/node_modules
+.stack-work
+tools/lsp/camligo/package.json
+tools/lsp/camligo/node_modules
+tools/lsp/camligo/log.html
+tools/lsp/camligo/src/
+tools/lsp/camligo/index.js
+tools/lsp/camligo/node_modules

tools/lsp/camligo/grammar.js

@@ -0,0 +1,470 @@
+let sepBy1 = (sep, rule) =>
+  seq(
+    rule,
+    repeat(seq(sep, rule)),
+    optional(sep)
+  )
+
+let sepBy = (sep, rule) => optional(sepBy1(sep, rule))
+
+let par      = x => seq('(', x, ')')
+let brackets = x => seq('[', x, ']')
+
+let ne_injection = (Kind, element) =>
+  choice(
+    seq(
+      Kind,
+      sepBy1(';', element),
+      'end',
+    ),
+    seq(
+      Kind,
+      '[',
+      sepBy1(';', element),
+      ']',
+    ),
+  )
+
+let injection = (Kind, element) =>
+  choice(
+    seq(
+      Kind,
+      sepBy(';', element),
+      'end',
+    ),
+    seq(
+      Kind,
+      '[',
+      sepBy(';', element),
+      ']',
+    ),
+  )
+
+let tuple  = x => seq(x, ',', x, repeat(seq(',', x)))
+let list__ = x => brackets(sepBy(';', x))
+
+let nseq = x => seq(x, repeat(x))
+
+let op = (l, x, r, def) =>
+  choice(
+    seq(l, x, r),
+    def,
+  )
+
+let rop = (l, x, r) => op(l, x, r, r)
+let lop = (l, x, r) => op(l, x, r, l)
+
+module.exports = grammar({
+  name: 'CAMLigo',
+
+  word:   $ => $.Keyword,
+  extras: $ => [$.ocaml_comment, $.comment, /\s/],
+
+  conflicts: $ => [[$.call, $.if_then_else]],
+
+  rules: {
+    // debug: $ => $.expr,
+
+    contract: $ => repeat($.declaration),
+
+    expr: $ =>
+      choice(
+        $.let_expr,
+        $.op_call,
+      ),
+
+    let_expr: $ =>
+      prec.left(0,
+        seq(
+          'let',
+          $.let_binding,
+          repeat($.attr),
+          'in',
+          $.expr,
+        ),
+      ),
+
+    op_call: $ =>
+      $.tuple,
+
+    tuple: $ => prec.left(2, rop($.tuple, ',', $.disj)),
+    disj: $ => prec.left(3, rop($.disj, $.or, $.conj)),
+    conj: $ => prec.left(4, rop($.conj, $.and, $.comp)),
+    comp: $ => prec.left(5, rop($.comp, $.compare, $.cat)),
+    cat:  $ => prec.left(6, lop($.cons, $.catenate, $.cat)),
+    cons: $ => prec.right(7, lop($.add, $.consolidate, $.cons)),
+    add:  $ => prec.left(8, rop($.add, $.plus, $.mult)),
+    mult: $ => prec.left(9, rop($.mult, $.times, $.unary)),
+
+    unary: $ =>
+      seq(
+        optional($.negate),
+        $.call,
+      ),
+
+    or: $ => choice('||', 'or'),
+    and: $ => '&&',
+    compare: $ => choice('<', '<=', '>', '>=', '=', '<>'),
+    catenate: $ => '^',
+    consolidate: $ => '::',
+    plus: $ => choice('+', '-'),
+    times: $ => choice('*', '/', 'mod'),
+    negate: $ => choice('-', 'not'),
+
+    call: $ =>
+      prec.left(1,
+        choice(
+          seq($.call, $.term),
+          $.term,
+        ),
+      ),
+
+    term: $ =>
+      choice(
+        $.ref,
+        $.if_then_else,
+        $.literal,
+        $.match,
+      ),
+
+    match: $ =>
+      prec.right(0,
+        seq(
+          'match',
+          $.expr,
+          'with',
+          optional('|'),
+          sepBy1('|', $.alt),
+        ),
+      ),
+
+    alt: $ =>
+      prec.right(0,
+        seq(
+          $.pattern,
+          '->',
+          $.expr,
+        ),
+      ),
+
+    literal: $ =>
+      choice(
+        $.Nat,
+        $.Int,
+        $.Tez,
+        $.String,
+        $.Bytes,
+        $.group,
+        $.annotation,
+        $.list,
+        $.lambda,
+        $.unit,
+        $.record,
+        $.record_update,
+      ),
+
+    record: $ =>
+      seq(
+        '{',
+        sepBy1(';', $.record_field),
+        '}',
+      ),
+
+    record_update: $ =>
+      seq(
+        '{',
+        $.name,
+        'with',
+        sepBy1(';', $.record_field_update),
+        '}',
+      ),
+
+    record_field_update: $ =>
+      seq(
+        sepBy1('.', $.name),
+        '=',
+        $.expr,
+      ),
+
+    record_field: $ =>
+      seq(
+        $.name,
+        '=',
+        $.expr,
+      ),
+
+    unit: $ => seq('(', ')'),
+
+    lambda: $ =>
+      seq(
+        'fun',
+        repeat($.pattern_term),
+        '->',
+        $.expr,
+      ),
+
+    list: $ =>
+      seq(
+        '[',
+        sepBy(';', $.expr),
+        ']',
+      ),
+
+    annotation: $ =>
+      seq(
+        '(',
+        $.expr,
+        ':',
+        $.type_expr,
+        ')',
+      ),
+
+    group: $ =>
+      seq(
+        '(',
+        $.expr,
+        ')',
+      ),
+
+    if_then_else: $ =>
+      prec.right(0,
+        seq(
+          'if',
+          $.expr,
+          'then',
+          $.expr,
+          'else',
+          $.expr,
+        ),
+      ),
+
+    ref: $ =>
+      choice(
+        $.module_qualified,
+        $.struct_qualified,
+        $.name,
+        $.constr,
+      ),
+
+    module_qualified: $ =>
+      seq(
+        $.constr,
+        '.',
+        $.name,
+      ),
+
+    struct_qualified: $ =>
+      seq(
+        $.name,
+        nseq(seq('.', $.accessor)),
+      ),
+
+    accessor: $ => choice($.name, $.Int),
+
+    declaration: $ =>
+      choice(
+        $.type_decl,
+        $.let_declaration,
+      ),
+
+    type_decl: $ =>
+      seq(
+        'type',
+        $.type_name,
+        '=',
+        $.type_expr,
+      ),
+
+    type_expr: $ =>
+      choice(
+        $.fun_type,
+        $.sum_type,
+        $.record_type,
+      ),
+
+    fun_type: $ =>
+      seq(
+        $.cartesian,
+        optional(seq('->', $.fun_type)),
+      ),
+
+    cartesian: $ =>
+      prec.left(1,
+        seq(
+          $.core_type,
+          optional(seq('*', sepBy('*', $.core_type))),
+        ),
+      ),
+
+    core_type: $ =>
+      choice(
+        $.type_name,
+        par($.type_expr),
+        $.module_type_name,
+        $.type_application
+      ),
+
+    module_type_name: $ =>
+      seq(
+        $.module_name,
+        '.',
+        $.type_name,
+      ),
+
+    type_application: $ =>
+      seq(
+        choice($.core_type, $.type_tuple),
+        $.type_name,
+      ),
+
+    type_tuple: $ =>
+      par(tuple($.type_expr)),
+
+    sum_type: $ =>
+      seq(
+        optional('|'),
+        sepBy1('|', $.variant),
+      ),
+
+    variant: $ =>
+      seq(
+        $.constr,
+        optional(seq('of', $.fun_type)),
+      ),
+
+    record_type: $ =>
+      seq(
+        '{',
+        sepBy(';', $.field_decl),
+        '}',
+      ),
+
+    field_decl: $ =>
+      seq(
+       $.field_name,
+       ':',
+       $.type_expr,
+      ),
+
+    let_declaration: $ =>
+      seq(
+        'let',
+        optional($.rec),
+        $.let_binding,
+        repeat($.attr),
+      ),
+
+    let_binding: $ =>
+      choice(
+        seq(
+          $.name,
+          nseq($.pattern_term),
+          optional($.type_annotation),
+          '=',
+          $.expr,
+        ),
+        seq(
+          $.pattern,
+          optional($.type_annotation),
+          '=',
+          $.expr,
+        ),
+      ),
+
+    type_annotation: $ => seq(':', $.type_expr),
+
+    pattern_term: $ =>
+      choice(
+        $.pattern_record,
+        $.constr,
+        $.pattern_list,
+        $.pattern_constant,
+        $.name,
+        $.pattern_grouped,
+      ),
+
+    pattern_grouped: $ =>
+      seq(
+        '(',
+        $.pattern,
+        optional($.type_annotation),
+        ')',
+      ),
+
+    pattern_list: $ => list__($.pattern),
+    pattern_constant: $ =>
+      choice(
+        $.Nat,
+        $.String,
+        $.Bytes,
+        $.Int,
+      ),
+
+    pattern_record: $ =>
+      seq(
+        '{',
+        sepBy1(';', $.pattern_record_field),
+        '}',
+      ),
+
+    pattern_record_field: $ =>
+      seq(
+        $.name,
+        '=',
+        $.pattern,
+      ),
+
+    pattern:       $ => sepBy1('::', $.pattern_tuple),
+    pattern_tuple: $ => sepBy1(',', $.construct),
+
+    construct: $ =>
+      choice(
+        seq($.constr, nseq($.pattern_term)),
+        $.pattern_term,
+      ),
+
+ ///////////////////////////////////////////
+
+    type_name: $ => $.ident,
+    field_name: $ => $.ident,
+    fun_name: $ => $.ident,
+    struct_name: $ => $.ident,
+    var: $ => $.ident,
+    module_name: $ => $.Name_Capital,
+    constr: $ => $.Name_Capital,
+    ident: $ => $.Name,
+    name: $ => $.Name,
+
+    comment: $ => /\/\/[^\n]*\n/,
+
+    ocaml_comment: $ => seq(
+      '(*',
+      repeat(choice(
+        $.ocaml_comment,
+        /[^\(]|\(?!\*/,
+      )),
+      '*)'
+    ),
+
+    include: $ => seq('#include', $.String),
+
+    String:       $ => /\"(\\.|[^"])*\"/,
+    Int:          $ => /-?([1-9][0-9_]*|0)/,
+    Nat:          $ => /([1-9][0-9_]*|0)n/,
+    Tez:          $ => /([1-9][0-9_]*|0)(\.[0-9_]+)?(tz|tez|mutez)/,
+    Bytes:        $ => /0x[0-9a-fA-F]+/,
+    Name:         $ => /[a-z][a-zA-Z0-9_]*/,
+    Name_Capital: $ => /[A-Z][a-zA-Z0-9_]*/,
+    Keyword:      $ => /[A-Za-z][a-z]*/,
+
+    False:        $ => 'False',
+    True:         $ => 'True',
+    Unit:         $ => 'Unit',
+    None:         $ => 'None',
+    Some:         $ => 'Some',
+    skip:         $ => 'skip',
+    rec:          $ => 'rec',
+
+    attr:         $ => seq('[@@', $.name, ']'),
+  }
+});

tools/lsp/pascaligo/LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2020 LigoLANG SASU
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

tools/lsp/pascaligo/grammar.js

@@ -0,0 +1,840 @@
+let sepBy1 = (sep, rule) =>
+  seq(
+    rule,
+    repeat(seq(sep, rule)),
+    optional(sep)
+  )
+
+let sepBy = (sep, rule) => optional(sepBy1(sep, rule))
+
+let op = (name, left, right, term) =>
+  choice(
+    seq(left, name, right),
+    term,
+  )
+
+let right_op = (name, left, right) => op(name, left, right, right)
+let left_op  = (name, left, right) => op(name, left, right, left)
+
+let par = x => seq('(', x, ')')
+let brackets = x => seq('[', x, ']')
+
+let ne_injection = (Kind, element) =>
+  choice(
+    seq(
+      Kind,
+      sepBy1(';', element),
+      'end',
+    ),
+    seq(
+      Kind,
+      '[',
+      sepBy1(';', element),
+      ']',
+    ),
+  )
+
+let injection = (Kind, element) =>
+  choice(
+    seq(
+      Kind,
+      sepBy(';', element),
+      'end',
+    ),
+    seq(
+      Kind,
+      '[',
+      sepBy(';', element),
+      ']',
+    ),
+  )
+
+module.exports = grammar({
+  name: 'PascaLigo',
+
+  word:   $ => $.Keyword,
+  extras: $ => [$.ocaml_comment, $.comment, /\s/],
+
+  rules: {
+    // debug: $ => $.block,
+
+    contract: $ => repeat(field("declaration", $._declaration)),
+
+    _declaration: $ =>
+      choice(
+        $.type_decl,
+        $.const_decl,
+        $.fun_decl,
+        $.attr_decl,
+        $.include,
+      ),
+
+    attr_decl: $ =>
+      seq(
+        $._open_attr_decl,
+        optional(';'),
+      ),
+
+    _open_attr_decl: $ =>
+      injection("attributes",
+        field("attribute", $.String)),
+
+    type_decl: $ =>
+      seq(
+        "type",
+        field("typeName", $.Name),
+        "is",
+        field("typeValue", $._type_expr),
+        optional(';'),
+      ),
+
+    type_expr : $ => $._type_expr,
+
+    _type_expr: $ =>
+      choice(
+        $.fun_type,
+        $.sum_type,
+        $.record_type,
+      ),
+
+    fun_type: $ =>
+      choice(
+        field("domain", $.cartesian),
+        seq(
+          field("domain", $.cartesian),
+          '->',
+          field("codomain", $.fun_type),
+        ),
+      ),
+
+    cartesian: $ =>
+      sepBy1('*', field("element", $._core_type)),
+
+    _core_type: $ =>
+      choice(
+        $.Name,
+        par($.type_expr),
+        $.invokeBinary,
+        $.invokeUnary,
+      ),
+
+    invokeBinary: $ =>
+      seq(
+        field("typeConstr", choice('map', 'big_map', $.Name)),
+        field("arguments", $.type_tuple),
+      ),
+
+    invokeUnary: $ =>
+      seq(
+        field("typeConstr", choice('list', 'set')),
+        field("arguments", par($._type_expr)),
+      ),
+
+    map:     $ => 'map',
+    big_map: $ => 'big_map',
+    list:    $ => 'list',
+    set:     $ => 'set',
+
+    type_tuple: $ => par(sepBy1(',', field("element", $._type_expr))),
+
+    sum_type: $ =>
+      seq(
+        optional('|'),
+        sepBy1('|', field("variant", $.variant)),
+      ),
+
+    variant: $ =>
+      choice(
+        field("constructor", $.constr),
+        seq(
+          field("constructor", $.constr),
+          'of',
+          field("arguments", $.fun_type)
+        ),
+      ),
+
+    constr: $ => $.Name_Capital,
+
+    record_type: $ =>
+      choice(
+        seq('record',      sepBy(';', field("field", $.field_decl)), 'end'),
+        seq('record', '[', sepBy(';', field("field", $.field_decl)), ']'),
+      ),
+
+    field_decl: $ =>
+      seq(
+        field("fieldName", $.Name),
+        ':',
+        field("fieldType", $._type_expr),
+      ),
+
+    fun_expr: $ =>
+      seq(
+        field("recursive", optional($.recursive)),
+        'function',
+        field("parameters", $.parameters),
+        ':',
+        field("type", $._type_expr),
+        'is',
+        field("body", $._expr),
+      ),
+
+    _open_fun_decl: $ =>
+      seq(
+        field("recursive", optional($.recursive)),
+        'function',
+        field("name", $.Name),
+        field("parameters", $.parameters),
+        ':',
+        field("type", $._type_expr),
+        'is',
+        optional(seq(
+          field("locals", $.block),
+          'with',
+        )),
+        field("body", $._expr),
+      ),
+
+    fun_decl: $ =>
+      seq(
+        field("_open_fun_decl", $._open_fun_decl),
+        optional(';'),
+      ),
+
+    parameters: $ => par(sepBy(';', field("parameter", $.param_decl))),
+
+    param_decl: $ =>
+      seq(
+        field("access", $.access),
+        field("name", $.Name),
+        ':',
+        field("type", $._param_type),
+      ),
+
+    access: $ => choice('var', 'const'),
+
+    _param_type: $ => $.fun_type,
+
+    _statement: $ =>
+      choice(
+        $._instruction,
+        $._open_data_decl,
+        $._open_attr_decl,
+      ),
+
+    _open_data_decl: $ =>
+      choice(
+        $.open_const_decl,
+        $.open_var_decl,
+        $._open_fun_decl,
+      ),
+
+    open_const_decl: $ =>
+      seq(
+        'const',
+        field("name", $.Name),
+        ':',
+        field("type", $._type_expr),
+        '=',
+        field("value", $._expr),
+      ),
+
+    open_var_decl: $ =>
+      seq(
+        'var',
+        field("name", $.Name),
+        ':',
+        field("type", $._type_expr),
+        ':=',
+        field("value", $._expr),
+      ),
+
+    const_decl: $ =>
+      seq(
+        $.open_const_decl,
+        optional(';'),
+      ),
+
+    _instruction: $ =>
+      choice(
+        $.conditional,
+        $.case_instr,
+        $.assignment,
+        $.loop,
+        $._proc_call,
+        $.skip,
+        $.record_patch,
+        $.map_patch,
+        $.set_patch,
+        $.map_remove,
+        $.set_remove,
+      ),
+
+    set_remove: $ =>
+      seq(
+        'remove',
+        field("key", $._expr),
+        'from',
+        'set',
+        field("container", $.path),
+      ),
+
+    map_remove: $ =>
+      seq(
+        'remove',
+        field("key", $._expr),
+        'from',
+        'map',
+        field("container", $.path),
+      ),
+
+    set_patch: $ =>
+      seq(
+        'patch',
+        field("container", $.path),
+        'with',
+        ne_injection('set', field("key", $._expr)),
+      ),
+
+    map_patch: $ =>
+      seq(
+        'patch',
+        field("container", $.path),
+        'with',
+        ne_injection('map', field("binding", $.binding)),
+      ),
+
+    binding: $ =>
+      seq(
+        field("key", $._expr),
+        '->',
+        field("value", $._expr),
+      ),
+
+    record_patch: $ =>
+      seq(
+        'patch',
+        field("container", $.path),
+        'with',
+        ne_injection('record', field("binding", $.field_assignment)),
+      ),
+
+    _proc_call: $ =>
+      $.fun_call,
+
+    conditional: $ =>
+      seq(
+        'if',
+        field("selector", $._expr),
+        'then',
+        field("then", $.if_clause),
+        optional(';'),
+        'else',
+        field("else", $.if_clause),
+      ),
+
+    if_clause: $ =>
+      choice(
+        $._instruction,
+        $.clause_block,
+      ),
+
+    clause_block: $ =>
+      choice(
+        field("block", $.block),
+        seq('{', sepBy1(';', field("statement", $._statement)), '}')
+      ),
+
+    block: $ =>
+      choice(
+        seq(
+          'begin',
+          sepBy(';', field("statement", $._statement)),
+          'end',
+        ),
+        seq(
+          'block',
+          '{',
+          sepBy(';', field("statement", $._statement)),
+          '}',
+        ),
+      ),
+
+    case_instr: $ =>
+      choice(
+        seq(
+          'case',
+          field("subject", $._expr),
+          'of',
+          optional('|'),
+          sepBy1('|', field("case", $.case_clause_instr)),
+          'end'
+        ),
+        seq(
+          'case',
+          $._expr,
+          'of',
+          '[',
+          optional('|'),
+          sepBy1('|', field("case", $.case_clause_instr)),
+          ']'
+        ),
+      ),
+
+    case_clause_instr: $ =>
+      seq(
+        field("pattern", $.pattern),
+        '->',
+        field("body", $.if_clause),
+      ),
+
+    assignment: $ =>
+      seq(
+        field("LHS", $._lhs),
+        ':=',
+        field("RHS", $._rhs),
+      ),
+
+    _rhs: $ => $._expr,
+    _lhs: $ => choice($.path, $.map_lookup),
+
+    loop: $ => choice($.while_loop, $.for_loop),
+
+    while_loop: $ =>
+      seq(
+        'while',
+        field("breaker", $._expr),
+        field("body", $.block),
+      ),
+
+    for_loop: $ =>
+      choice(
+        seq(
+          'for',
+          field("name", $.Name),
+          ':=',
+          field("begin", $._rhs),
+          'to',
+          field("end", $._expr),
+          field("body", $.block),
+        ),
+        seq(
+          'for',
+          field("key", $.Name),
+          optional(seq('->', field("value", $.Name))),
+          'in',
+          field("kind", $.collection),
+          field("collection", $._expr),
+          field("body", $.block),
+        ),
+      ),
+
+    collection: $ => choice('map', 'set', 'list'),
+
+    interactive_expr: $ => $._expr,
+
+    _expr: $ =>
+      choice(
+        $.case_expr,
+        $.cond_expr,
+        $.disj_expr,
+        $.fun_expr,
+      ),
+
+    case_expr: $ =>
+      choice(
+        seq(
+          'case',
+          field("subject", $._expr),
+          'of',
+          optional('|'),
+          sepBy1('|', field("case", $.case_clause_expr)),
+          'end'
+        ),
+        seq(
+          'case',
+          field("subject", $._expr),
+          'of',
+          '[',
+          optional('|'),
+          sepBy1('|', field("case", $.case_clause_expr)),
+          ']'
+        ),
+      ),
+
+    case_clause_expr: $ =>
+      seq(
+        field("pattern", $.pattern),
+        '->',
+        field("body", $._expr),
+      ),
+
+    cond_expr: $ =>
+      seq(
+        'if',
+        field("selector", $._expr),
+        'then',
+        field("then", $._expr),
+        optional(';'),
+        'else',
+        field("else", $._expr),
+      ),
+
+    disj_expr: $ =>
+      choice(
+        field("the", $.conj_expr),
+        seq(field("arg1", $.disj_expr), 'or', field("arg2", $.conj_expr)),
+      ),
+
+    conj_expr: $ =>
+      choice(
+        field("the", $.set_membership),
+        seq(
+          field("arg1", $.conj_expr),
+          'and',
+          field("arg2", $.set_membership)
+        ),
+      ),
+
+    set_membership: $ =>
+      choice(
+        field("the", $.comp_expr),
+        seq(
+          field("arg1", $._core_expr),
+          'contains',
+          field("arg2", $.set_membership)
+        ),
+      ),
+
+    comp_expr: $ =>
+      choice(
+        field("the", $.cat_expr),
+        seq(
+          field("arg1", $.comp_expr),
+          field("compare", $.comparison),
+          field("arg2", $.cat_expr),
+        ),
+      ),
+
+    comparison: $ => choice('<', '<=', '>', '>=', '=', '=/='),
+
+    cat_expr: $ =>
+      choice(
+        field("the", $.cons_expr),
+        seq(
+          field("arg1", $.cons_expr),
+          '^',
+          field("arg2", $.cat_expr),
+        ),
+      ),
+
+    cons_expr: $ =>
+      choice(
+        field("the", $.add_expr),
+        seq(
+          field("arg1", $.add_expr),
+          '#',
+          field("arg2", $.cons_expr)
+        ),
+      ),
+
+    add_expr: $ =>
+      choice(
+        field("the", $.mult_expr),
+        seq(
+          field("arg1", $.add_expr),
+          field("add", $.adder),
+          field("arg2", $.mult_expr),
+        ),
+      ),
+
+    adder: $ => choice('-', '+'),
+
+    mult_expr: $ =>
+      choice(
+        field("the", $.unary_expr),
+        seq(
+          field("arg1", $.mult_expr),
+          field("multiply", $.multiplier),
+          field("arg2", $.unary_expr),
+        ),
+      ),
+
+    multiplier: $ => choice('/', '*', 'mod'),
+
+    unary_expr: $ =>
+      choice(
+        field("the", $._core_expr),
+        seq(
+          field("negate", $.negate),
+          field("arg", $._core_expr),
+        ),
+      ),
+
+    negate: $ => choice('-', 'not'),
+
+    _core_expr: $ =>
+      choice(
+        $.Int,
+        $.Nat,
+        $.Tez,
+        $.Name,
+        $.module_field,
+        $.String,
+        $.Bytes,
+        $.False,
+        $.True,
+        $.Unit,
+        $.annot_expr,
+        $.tuple_expr,
+        $.list_expr,
+        $.None,
+        $._fun_call_or_par_or_projection,
+        $._map_expr,
+        $.set_expr,
+        $.record_expr,
+        $.update_record,
+        $.constr_call,
+        $.Some_call,
+      ),
+
+    constr_call: $ =>
+      seq(
+        field("constr", $.constr),
+        optional(
+          field("arguments", $.arguments)
+        ),
+      ),
+
+    Some_call: $ =>
+      seq(
+        field("constr", 'Some'),
+        field("arguments", $.arguments),
+      ),
+
+    _fun_call_or_par_or_projection: $ =>
+      choice(
+        $.par_call,
+        $.projection_call,
+        $.fun_call,
+      ),
+
+    par_call: $ =>
+      prec.right(1, seq(
+        par(field("f", $._expr)),
+        optional(field("arguments", $.arguments))
+      )),
+
+    projection_call: $ => seq(
+      field("f", $._projection),
+      optional(field("arguments", $.arguments)),
+    ),
+
+    annot_expr: $ =>
+      par(seq(
+        field("subject", $.disj_expr),
+        ':',
+        field("type", $._type_expr)
+      )),
+
+    set_expr: $ => injection('set', $._expr),
+
+    _map_expr: $ =>
+      choice(
+        $.map_lookup,
+        $.map_injection,
+        $.big_map_injection,
+      ),
+
+    map_injection: $ => injection('map', $.binding),
+    big_map_injection: $ => injection('big_map', $.binding),
+
+    map_lookup: $ =>
+      seq(
+        field("container", $.path),
+        brackets(field("index", $._expr)),
+      ),
+
+    path: $ => choice($.Name, $._projection),
+
+    module_field: $ =>
+      seq(
+        field("module", $.Name_Capital),
+        '.',
+        field("method", $._module_fun),
+      ),
+
+    _module_fun: $ =>
+      choice(
+        $.Name,
+        $.map,
+        $.or,
+        $.and,
+        $.remove,
+      ),
+
+    or: $ => 'or',
+    and: $ => 'and',
+    remove: $ => 'remove',
+
+    _projection: $ =>
+      choice(
+        $.data_projection,
+        $.module_projection,
+      ),
+
+    data_projection: $ => seq(
+      field("struct", $.Name),
+      '.',
+      sepBy1('.', field("index", $.selection)),
+    ),
+
+    module_projection: $ =>
+      seq(
+        field("module", $.Name_Capital),
+        '.',
+        field("index", $.Name),
+        '.',
+        sepBy1('.', field("index", $.selection)),
+      ),
+
+    selection: $ => choice($.Name, $.Int),
+
+    record_expr: $ =>
+      choice(
+        seq(
+          'record',
+          sepBy(';', field("assignment", $.field_assignment)),
+          'end',
+        ),
+        seq(
+          'record',
+          '[',
+          sepBy(';', field("assignment", $.field_assignment)),
+          ']',
+        ),
+      ),
+
+    update_record: $ =>
+      seq(
+        field("record", $.path),
+        'with',
+        ne_injection('record', field("assignment", $.field_path_assignment)),
+      ),
+
+    field_assignment: $ =>
+      seq(
+        field("name", $.Name),
+        '=',
+        field("_rhs", $._expr),
+      ),
+
+    field_path_assignment: $ =>
+      seq(
+        sepBy1('.', field("index", $.Name)),
+        '=',
+        field("_rhs", $._expr),
+      ),
+
+    fun_call: $ =>
+      seq(
+        field("f", choice($.Name, $.module_field)),
+        field("arguments", $.arguments),
+      ),
+
+    tuple_expr: $ => par(sepBy1(',', field("element",  $._expr))),
+    arguments:  $ => par(sepBy(',',  field("argument", $._expr))),
+
+    list_expr: $ => choice($.list_injection, 'nil'),
+
+    list_injection: $ => injection('list', field("element", $._expr)),
+
+    pattern: $ => sepBy1('#', field("arg", $._core_pattern)),
+
+    _core_pattern: $ =>
+      choice(
+        $.Name,
+        '_',
+        $.Int,
+        $.Nat,
+        $.String,
+        $.list_pattern,
+        $.tuple_pattern,
+        $._constr_pattern,
+      ),
+
+    list_pattern: $ =>
+      choice(
+        injection("list", field("element", $._core_pattern)),
+        'nil',
+        par($.cons_pattern),
+      ),
+
+    cons_pattern: $ =>
+      seq(
+        field("head", $._core_pattern),
+        '#',
+        field("tail", $.pattern),
+      ),
+
+    tuple_pattern: $ =>
+      par(sepBy1(',', field("element", $._core_pattern))),
+
+    _constr_pattern: $ => choice(
+      $.Unit,
+      $.False,
+      $.True,
+      $.None,
+      $.Some_pattern,
+      $.user_constr_pattern,
+    ),
+
+    Some_pattern: $ =>
+      seq(
+        field("constr", 'Some'),
+        par(field("arg", $._core_pattern)),
+      ),
+
+    user_constr_pattern: $ =>
+      seq(
+        field("constr", $.constr),
+        optional(field("arguments", $.tuple_pattern)),
+      ),
+
+    ///////////////////////////////////////////
+
+    comment: $ => /\/\/[^\n]*\n/,
+
+    ocaml_comment: $ =>
+      seq(
+        '(*',
+        repeat(choice(
+          $.ocaml_comment,
+          /'([^'\\]|\\[\\"'ntbr ]|\\[0-9][0-9][0-9]|\\x[0-9A-Fa-f][0-9A-Fa-f]|\\o[0-3][0-7][0-7])'/,
+          /"([^\\"]|\\(.|\n))*"/,
+          /[A-Za-z_][a-zA-Z0-9_']*/,
+          /[^('"{*A-Za-z_]+/,
+          '(', "'", '*',
+        )),
+        '*)'
+      ),
+
+    include: $ => seq('#include', $.String),
+
+    String:       $ => /\"(\\.|[^"])*\"/,
+    Int:          $ => /-?([1-9][0-9_]*|0)/,
+    Nat:          $ => /([1-9][0-9_]*|0)n/,
+    Tez:          $ => /([1-9][0-9_]*|0)(\.[0-9_]+)?(tz|tez|mutez)/,
+    Bytes:        $ => /0x[0-9a-fA-F]+/,
+    Name:         $ => /[a-z][a-zA-Z0-9_]*/,
+    Name_Capital: $ => /[A-Z][a-zA-Z0-9_]*/,
+    Keyword:      $ => /[A-Za-z][a-z]*/,
+
+    False:         $ => 'False',
+    True:          $ => 'True',
+    Unit:          $ => 'Unit',
+    None:          $ => 'None',
+    skip:          $ => 'skip',
+    recursive: $ => 'recursive',
+  }
+});

tools/lsp/pascaligo/test.ligo

@@ -0,0 +1 @@
+Some(Unit) # Some(Foo(Bar, Unit))

tools/lsp/pascaligo/test/corpus/examples.txt

@@ -0,0 +1,29 @@
+=========
+Includes
+=========
+
+#include "foo.bar"
+#include "qux.ligo"
+
+---
+
+(source_file
+  (include
+    (string))
+  (include
+    (string)))
+
+=========
+Functions
+=========
+
+function add (const a : int ; const b : int) : int is
+  block { skip } with 1
+
+---
+
+(source_file
+  (include
+    (string))
+  (include
+    (string)))

tools/lsp/squirrel/app/Main.hs

@@ -0,0 +1,12 @@
+
+import ParseTree
+import Parser
+import AST
+
+import System.Environment
+
+main :: IO ()
+main = do
+  [fin] <- getArgs
+  toParseTree fin >>= print
+  runParser contract fin >>= print

tools/lsp/squirrel/examples/sanity.ligo

@@ -0,0 +1 @@
+function foo (var x : int) is 1

tools/lsp/squirrel/package.yaml

@@ -0,0 +1,41 @@
+
+name: squirrel
+
+dependencies:
+- base
+- bytestring
+- mtl
+- text
+- tree-sitter
+- pretty
+
+default-extensions:
+- LambdaCase
+- BlockArguments
+- OverloadedStrings
+- GeneralisedNewtypeDeriving
+- DerivingStrategies
+- NamedFieldPuns
+- BangPatterns
+
+ghc-options: -freverse-errors -Wall
+
+library:
+  source-dirs:
+  - src/
+
+  include-dirs:
+  - vendor
+
+  c-sources:
+  - vendor/parser.c
+
+executables:
+  squirrel:
+    main: Main.hs
+
+    source-dirs:
+    - app/
+
+    dependencies:
+    - squirrel

tools/lsp/squirrel/squirrel.cabal

@@ -0,0 +1,53 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.31.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: 67ec249f56014b97ea36ef06bb0dad0986e0f632e7fe62dc4393a5a081cb0493
+
+name:           squirrel
+version:        0.0.0
+build-type:     Simple
+
+library
+  exposed-modules:
+      AST
+      Parser
+      ParseTree
+  other-modules:
+      Paths_squirrel
+  hs-source-dirs:
+      src/
+  default-extensions: LambdaCase BlockArguments OverloadedStrings GeneralisedNewtypeDeriving DerivingStrategies NamedFieldPuns BangPatterns
+  ghc-options: -freverse-errors -Wall
+  include-dirs:
+      vendor
+  c-sources:
+      vendor/parser.c
+  build-depends:
+      base
+    , bytestring
+    , mtl
+    , pretty
+    , text
+    , tree-sitter
+  default-language: Haskell2010
+
+executable squirrel
+  main-is: Main.hs
+  other-modules:
+      Paths_squirrel
+  hs-source-dirs:
+      app/
+  default-extensions: LambdaCase BlockArguments OverloadedStrings GeneralisedNewtypeDeriving DerivingStrategies NamedFieldPuns BangPatterns
+  ghc-options: -freverse-errors -Wall
+  build-depends:
+      base
+    , bytestring
+    , mtl
+    , pretty
+    , squirrel
+    , text
+    , tree-sitter
+  default-language: Haskell2010

tools/lsp/squirrel/src/AST.hs

@@ -0,0 +1,209 @@
+
+{- annotate tree with ranges, add offsets to ranges, store verbatim in Wrong* -}
+
+module AST where
+
+import Control.Monad.State
+
+import qualified Data.Text as Text
+import Data.Text (Text)
+import Data.Void
+
+import Parser
+import ParseTree
+
+import Debug.Trace
+
+type TODO = Text
+
+data Contract info
+  = Contract      info [Declaration info]
+  | WrongContract      Error
+  deriving stock (Show)
+
+instance Stubbed (Contract info) where stub = WrongContract
+
+data Declaration info
+  = ValueDecl info (Binding info)
+  | WrongDecl      Error
+  deriving stock (Show)
+
+instance Stubbed (Declaration info) where stub = WrongDecl
+
+data Binding info
+  = Irrefutable  info (Pattern info) (Expr info)
+  | Function     info Bool (Name info) [VarDecl info] (Type info) TODO
+  | WrongBinding      Error
+  deriving stock (Show)
+
+instance Stubbed (Binding info) where stub = WrongBinding
+
+data VarDecl info
+  = Decl         info (Mutable info) (Name info) (Type info)
+  | WrongVarDecl      Error
+  deriving stock (Show)
+
+instance Stubbed (VarDecl info) where stub = WrongVarDecl
+
+data Mutable info
+  = Mutable      info
+  | Immutable    info
+  | WrongMutable      Error
+  deriving stock (Show)
+
+instance Stubbed (Mutable info) where stub = WrongMutable
+
+data Type info
+  = TArrow    info  (Type info) (Type info)
+  | Record    info [(Name info, Type info)]
+  | TVar      info  (Name info)
+  | Sum       info [(Name info, [Type info])]
+  | Product   info  [Type info]
+  | TApply    info  (Name info) [Type info]
+  | WrongType      Error
+  deriving stock (Show)
+
+instance Stubbed (Type info) where stub = WrongType
+
+data Expr info
+  = Let       info [Declaration info] (Expr info)
+  | Apply     info (Expr info) (Expr info)
+  | Constant  info (Constant info)
+  | Ident     info (QualifiedName info)
+  | WrongExpr      Error
+  deriving stock (Show)
+
+instance Stubbed (Expr info) where stub = WrongExpr
+
+data Constant info
+  = Int     info Int
+  | String  info Text
+  | Float   info Double
+  | Bytes   info Text
+  | WrongConstant Error
+  deriving stock (Show)
+
+instance Stubbed (Constant info) where stub = WrongConstant
+
+data Pattern info
+  = IsConstr     info (Name info) [Pattern info]
+  | IsConstant   info (Constant info)
+  | IsVar        info (Name info)
+  | WrongPattern      Error
+  deriving stock (Show)
+
+instance Stubbed (Pattern info) where stub = WrongPattern
+
+data QualifiedName info = QualifiedName
+  { source :: Name info
+  , path   :: [Name info]
+  }
+  | WrongQualifiedName Error
+  deriving stock (Show)
+
+instance Stubbed (QualifiedName info) where stub = WrongQualifiedName
+
+data Name info = Name
+  { info    :: info
+  , raw     :: Text
+  }
+  | WrongName Error
+
+instance Stubbed (Name info) where stub = WrongName
+
+instance Show (Name info) where
+  show = \case
+    Name _ raw  -> Text.unpack raw
+    WrongName r -> "(Name? " ++ show r ++ ")"
+
+name :: Parser (Name Range)
+name = do
+  (raw, info) <- range (token "Name")
+  return Name {info, raw}
+
+contract :: Parser (Contract Range)
+contract = subtree "contract" do
+  (decls, info) <- range $ many "declaration" declaration
+  return (Contract info decls)
+
+declaration :: Parser (Declaration Range)
+declaration =
+  field "declaration" do
+    (b, info) <- range binding
+    return (ValueDecl info b)
+
+par x = do
+  consume "("
+  a <- x
+  consume ")"
+  return a
+
+binding :: Parser (Binding Range)
+binding = do
+  info <- getRange
+  "fun_decl" `subtree` do
+    recur <- optional do
+      field "recursive" do
+        token "recursive"
+    consume "function"
+    name <- field "name" do
+      name
+    params <- field "parameters" $ par (many "param" paramDecl)
+    consume ":"
+    ty     <- field "type" type_
+    consume "is"
+    get >>= traceShowM
+    expr   <- field "locals" anything
+    return (Function info (recur == Just "recursive") name params ty expr)
+
+paramDecl :: Parser (VarDecl Range)
+paramDecl = do
+  info <- getRange
+  "parameter" `field` do
+    info' <- getRange
+    mutable <- do
+      "access" `subtree` select
+        [ do consume "var"
+             return $ Mutable info'
+        , do consume "const"
+             return $ Immutable info'
+        ]
+    name <- field "name" name
+    consume ":"
+    ty <- field "type" type_
+    return (Decl info mutable name ty)
+
+newtype_ = do
+  type_
+
+type_ :: Parser (Type Range)
+type_ =
+    fun_type
+  where
+    fun_type :: Parser (Type Range)
+    fun_type = do
+      info <- getRange
+      domain <- field "domain" cartesian
+      codomain <- optional do
+        consume "->"
+        fun_type
+      return case codomain of
+        Just co -> TArrow info domain co
+        Nothing -> domain
+
+    cartesian = do
+      info <- getRange
+      Product info <$> some "corety" core_type
+
+    core_type = do
+      info <- getRange
+      select
+        [ TVar info <$> typename
+        ]
+
+    typename = name
+
+tuple :: Text -> Parser a -> Parser [a]
+tuple msg = par . some msg
+
+example = "../../ligo/src/test/contracts/address.ligo"

tools/lsp/squirrel/src/ParseTree.hs

@@ -0,0 +1,158 @@
+
+{-# language Strict #-}
+
+module ParseTree where
+
+import Data.IORef
+import qualified Data.Text as Text
+import Data.Traversable (for)
+import Data.Text.Foreign (withCStringLen)
+import Data.Text.IO as IO
+
+import           TreeSitter.Parser
+import           TreeSitter.Tree
+import           TreeSitter.Language
+import           TreeSitter.Node
+import           Foreign.C.String (peekCString)
+import           Foreign.Ptr                    ( Ptr
+                                                , nullPtr
+                                                )
+import           Foreign.Marshal.Alloc          ( alloca )
+import           Foreign.Marshal.Array          ( allocaArray )
+import           Foreign.Storable               ( peek
+                                                , peekElemOff
+                                                , poke
+                                                )
+import           Control.Monad ((>=>))
+
+import Text.PrettyPrint hiding ((<>))
+
+import Paths_squirrel
+
+-- import Debug.Trace
+
+foreign import ccall unsafe tree_sitter_PascaLigo :: Ptr Language
+
+getNodeTypesPath :: IO FilePath
+getNodeTypesPath = getDataFileName "../pascaligo/src/node-types.json"
+
+data ParseTree = ParseTree
+  { ptID       :: Int
+  , ptName     :: Text.Text
+  , ptStart    :: Int
+  , ptFinish   :: Int
+  , ptRange    :: Range
+  , ptChildren :: ParseForest
+  }
+
+data ParseForest = Forest
+  { pfID    :: Int
+  , pfGrove :: [(Text.Text, ParseTree)]
+  , pfRange :: Range
+  }
+
+instance Show ParseTree where
+  show = show . ppTree
+
+instance Show ParseForest where
+  show = show . vcat . map ppPair . pfGrove
+
+data Range = Range
+  { rStart  :: (Int, Int)
+  , rFinish :: (Int, Int)
+  }
+  deriving stock (Show)
+
+diffRange :: Range -> Range -> Range
+diffRange (Range ws wf) (Range ps _) = Range (max ws ps) wf
+
+ppTree :: ParseTree -> Doc
+ppTree (ParseTree _ n _ _ (Range (sr, sc) (fr, fc)) (Forest _ cs _)) =
+  parens
+    ( hang
+      (   quotes (text (Text.unpack n))
+      <+> brackets
+        ( int sr <> ":" <> int sc
+        <> " - "
+        <> int fr <> ":" <> int fc
+        )
+      )
+      2
+      (vcat (map ppPair cs)))
+
+ppPair (field, tree) =
+  if field == Text.empty
+  then nest 2 $ ppTree tree
+  else hang (text (Text.unpack field) <> ": ") 2 (ppTree tree)
+
+toParseTree :: FilePath -> IO ParseForest
+toParseTree fin = do
+  parser <- ts_parser_new
+  True   <- ts_parser_set_language parser tree_sitter_PascaLigo
+
+  src <- IO.readFile fin
+
+  idCounter <- newIORef 0
+
+  withCStringLen src \(str, len) -> do
+    tree <- ts_parser_parse_string parser nullPtr str len
+    finalTree <- withRootNode tree (peek >=> go idCounter)
+    return $ Forest 0 [("", finalTree)] (ptRange finalTree)
+
+  where
+    nextID :: IORef Int -> IO Int
+    nextID ref = do
+      modifyIORef' ref (+ 1)
+      readIORef ref
+
+    go :: IORef Int -> Node -> IO ParseTree
+    go idCounter node = do
+      let count = fromIntegral $ nodeChildCount node
+      allocaArray count \children -> do
+        alloca \tsNodePtr -> do
+          poke tsNodePtr $ nodeTSNode node
+          ts_node_copy_child_nodes tsNodePtr children
+          nodes <- for [0.. count - 1] \i -> do
+            peekElemOff children i
+
+          trees <- for nodes \node' -> do
+            tree <- go idCounter node'
+            field <-
+              if nodeFieldName node' == nullPtr
+              then return ""
+              else peekCString $ nodeFieldName node'
+            return (Text.pack field, tree)
+
+          ty <- peekCString $ nodeType node
+
+          TSNode start _ _ _ _ <- peek tsNodePtr
+
+          let
+            start2D  = nodeStartPoint node
+            finish2D = nodeEndPoint   node
+            i = fromIntegral
+
+          treeID <- nextID idCounter
+          fID    <- nextID idCounter
+
+          let
+            range = Range
+              { rStart  =
+                  ( i $ pointRow    start2D + 1
+                  , i $ pointColumn start2D + 1
+                  )
+
+              , rFinish =
+                  ( i $ pointRow    finish2D + 1
+                  , i $ pointColumn finish2D + 1
+                  )
+              }
+
+          return $ ParseTree
+            { ptID       = treeID
+            , ptName     = Text.pack ty
+            , ptStart    = fromIntegral start
+            , ptFinish   = fromIntegral $ nodeEndByte node
+            , ptRange    = range
+            , ptChildren = Forest fID trees range
+            }

tools/lsp/squirrel/src/Parser.hs

@@ -0,0 +1,217 @@
+
+module Parser where
+
+import Control.Monad.State
+import Control.Monad.Writer
+import Control.Monad.Reader
+import Control.Monad.Except
+import Control.Monad.Identity
+
+import Data.Text.Encoding
+-- import Data.Traversable (for)
+import Data.Text (Text, pack, unpack)
+
+import qualified Data.ByteString as ByteString
+import Data.ByteString (ByteString)
+
+import ParseTree
+
+-- import Debug.Trace
+
+data Error
+  = Expected Text Range
+  | Unexpected Range
+  deriving stock (Show)
+
+newtype Parser a = Parser
+  { unParser
+      :: WriterT [Error]
+      (  ReaderT ParserEnv
+      (  StateT  ParseForest
+      (  ExceptT Error
+      (  Identity ))))
+         a
+  }
+  deriving newtype
+    ( Functor
+    , Applicative
+    , Monad
+    , MonadState   ParseForest
+    , MonadWriter [Error]
+    , MonadReader  ParserEnv
+    , MonadError   Error
+    )
+
+takeNext :: Text -> Parser ParseTree
+takeNext msg = do
+  st@Forest {pfGrove, pfRange} <- get
+  case pfGrove of
+    [] -> die msg
+    (_, t) : f -> do
+      put st
+        { pfRange = diffRange pfRange (ptRange t)
+        , pfGrove = f
+        }
+      return t
+
+field :: Stubbed a => Text -> Parser a -> Parser a
+field name parser = do
+  grove <- gets pfGrove
+  case grove of
+    (name', t) : _
+      | name == name' -> do
+        sandbox True t
+
+    _ -> do
+      case lookup name grove of
+        Just tree -> sandbox False tree
+        Nothing   -> die name
+
+  where
+    sandbox firstOne tree@ParseTree {ptID, ptRange} = do
+      st@Forest {pfGrove = grove, pfRange = rng} <- get
+      let grove' = delete name grove
+      put Forest
+        { pfID    = ptID
+        , pfGrove = [(name, tree)]
+        , pfRange = ptRange
+        }
+
+      stubbed name parser <* put st
+        { pfGrove = grove'
+        , pfRange = if firstOne then diffRange rng ptRange else rng
+        }
+
+fallback :: Stubbed a => Text -> Parser a
+fallback msg = (stub . Expected msg) <$> getRange
+
+die :: Text -> Parser a
+die msg = throwError . Expected msg =<< getRange
+
+stubbed :: Stubbed a => Text -> Parser a -> Parser a
+stubbed msg parser = do
+  parser <|> fallback msg
+
+subtree :: Text -> Parser a -> Parser a
+subtree msg parser = do
+  ParseTree {ptChildren, ptName} <- takeNext msg
+  if ptName == msg
+  then do
+    save <- get
+    put ptChildren
+    parser <* put save
+  else do
+    die msg
+
+(<|>) :: Parser a -> Parser a -> Parser a
+Parser l <|> Parser r = Parser (l `catchError` const r)
+
+select :: [Parser a] -> Parser a
+select = foldl1 (<|>)
+
+optional :: Parser a -> Parser (Maybe a)
+optional p = fmap Just p <|> return Nothing
+
+many :: Text -> Parser a -> Parser [a]
+many msg p = many'
+  where
+    many' = some' <|> pure []
+    some' = (:) <$> (productive msg p) <*> many'
+
+some :: Text -> Parser a -> Parser [a]
+some msg p = some'
+  where
+    many' = some' <|> pure []
+    some' = (:) <$> (productive msg p) <*> many'
+
+getTreeID :: Parser (Maybe Int)
+getTreeID = Parser do
+  pfGrove <$> get >>= return . \case
+    [] -> Nothing
+    (_, tree) : _ -> Just (ptID tree)
+
+productive :: Text -> Parser a -> Parser a
+productive msg p = do
+  was <- getTreeID
+  res <- p
+  now <- getTreeID
+  unless (was /= now) do
+    error ("unproductive: " ++ unpack msg)
+  return res
+
+data ParserEnv = ParserEnv
+  { peRange  :: Range
+  , peSource :: ByteString
+  }
+
+runParser :: Parser a -> FilePath -> IO (a, [Error])
+runParser (Parser parser) fin = do
+  pforest <- toParseTree fin
+  text    <- ByteString.readFile fin
+  let
+    res
+      =      runIdentity
+      $      runExceptT
+      $ flip runStateT pforest
+      $ flip runReaderT (ParserEnv (pfRange pforest) text)
+      $      runWriterT
+      $ parser
+
+  either (error . show) (return . fst) res
+
+token :: Text -> Parser Text
+token node = do
+  tree@ParseTree {ptName, ptRange} <- takeNext node
+  if ptName == node
+  then do
+    source <- asks peSource
+    return (cutOut source tree)
+
+  else do
+    throwError $ Expected node ptRange
+
+anything :: Parser Text
+anything = do
+  tree <- takeNext "anything"
+  source <- asks peSource
+  return (cutOut source tree)
+
+consume :: Text -> Parser ()
+consume node = do
+  ParseTree {ptName, ptRange} <- takeNext node
+  when (ptName /= node) do
+    tell [Expected node ptRange]
+
+cutOut :: ByteString -> ParseTree -> Text
+cutOut bs (ParseTree _ _ s f _ _) =
+  decodeUtf8 $ ByteString.take (f - s) (ByteString.drop s bs)
+
+range :: Parser a -> Parser (a, Range)
+range parser =
+  get >>= \case
+    Forest {pfGrove = (,) _ ParseTree {ptRange} : _} -> do
+      a <- parser
+      return (a, ptRange)
+
+    Forest {pfRange} -> do
+      a <- parser
+      return (a, pfRange)
+
+getRange :: Parser Range
+getRange = snd <$> range (return ())
+
+delete :: Eq k => k -> [(k, v)] -> [(k, v)]
+delete _ [] = []
+delete k ((k', v) : rest) =
+  if k == k'
+  then rest
+  else (k', v) : delete k rest
+
+class Stubbed a where
+  stub :: Error -> a
+
+instance Stubbed [a] where
+  stub _ = []
+
+instance Stubbed Text where
+  stub e = pack ("<" <> show e <> ">")

tools/lsp/squirrel/src/example.txt

@@ -0,0 +1,132 @@
+('contract' [1:1 - 4:1]
+   ('declaration' [1:1 - 3:25]
+      ('fun_decl' [1:1 - 3:25]
+         ('open_fun_decl' [1:1 - 3:25]
+            ('function' [1:1 - 1:9])
+            ('fun_name' [1:10 - 1:14]
+               ('ident' [1:10 - 1:14] ('Name' [1:10 - 1:14])))
+            ('parameters' [1:15 - 1:35]
+               ('(' [1:15 - 1:16])
+               ('param_decl' [1:16 - 1:34]
+                  ('access' [1:16 - 1:21] ('const' [1:16 - 1:21]))
+                  ('var' [1:22 - 1:23]
+                     ('ident' [1:22 - 1:23] ('Name' [1:22 - 1:23])))
+                  (':' [1:24 - 1:25])
+                  ('param_type' [1:26 - 1:34]
+                     ('fun_type' [1:26 - 1:34]
+                        ('cartesian' [1:26 - 1:34]
+                           ('core_type' [1:26 - 1:34]
+                              ('type_name' [1:26 - 1:34]
+                                 ('ident' [1:26 - 1:34] ('Name' [1:26 - 1:34]))))))))
+               (')' [1:34 - 1:35]))
+            (':' [1:36 - 1:37])
+            ('type_expr' [1:38 - 1:45]
+               ('fun_type' [1:38 - 1:45]
+                  ('cartesian' [1:38 - 1:45]
+                     ('core_type' [1:38 - 1:45]
+                        ('type_name' [1:38 - 1:45]
+                           ('ident' [1:38 - 1:45] ('Name' [1:38 - 1:45])))))))
+            ('is' [1:46 - 1:48])
+            ('block' [1:49 - 3:2]
+               ('block' [1:49 - 1:54])
+               ('{' [1:55 - 1:56])
+               ('statement' [2:3 - 2:57]
+                  ('open_data_decl' [2:3 - 2:57]
+                     ('open_const_decl' [2:3 - 2:57]
+                        ('const' [2:3 - 2:8])
+                        ('var' [2:9 - 2:10] ('ident' [2:9 - 2:10] ('Name' [2:9 - 2:10])))
+                        (':' [2:11 - 2:12])
+                        ('type_expr' [2:13 - 2:28]
+                           ('fun_type' [2:13 - 2:28]
+                              ('cartesian' [2:13 - 2:28]
+                                 ('core_type' [2:13 - 2:28]
+                                    ('type_name' [2:13 - 2:21]
+                                       ('ident' [2:13 - 2:21] ('Name' [2:13 - 2:21])))
+                                    ('type_tuple' [2:22 - 2:28]
+                                       ('(' [2:22 - 2:23])
+                                       ('type_expr' [2:23 - 2:27]
+                                          ('fun_type' [2:23 - 2:27]
+                                             ('cartesian' [2:23 - 2:27]
+                                                ('core_type' [2:23 - 2:27]
+                                                   ('type_name' [2:23 - 2:27]
+                                                      ('ident' [2:23 - 2:27]
+                                                         ('Name' [2:23 - 2:27])))))))
+                                       (')' [2:27 - 2:28]))))))
+                        ('=' [2:29 - 2:30])
+                        ('expr' [2:31 - 2:57]
+                           ('disj_expr' [2:31 - 2:57]
+                              ('conj_expr' [2:31 - 2:57]
+                                 ('set_membership' [2:31 - 2:57]
+                                    ('comp_expr' [2:31 - 2:57]
+                                       ('cat_expr' [2:31 - 2:57]
+                                          ('cons_expr' [2:31 - 2:57]
+                                             ('add_expr' [2:31 - 2:57]
+                                                ('mult_expr' [2:31 - 2:57]
+                                                   ('unary_expr' [2:31 - 2:57]
+                                                      ('core_expr' [2:31 - 2:57]
+                                                         ('fun_call_or_par_or_projection' [2:31 - 2:57]
+                                                            ('fun_call' [2:31 - 2:57]
+                                                               ('module_field' [2:31 - 2:53]
+                                                                  ('module_name' [2:31 - 2:36]
+                                                                     ('Name_Capital' [2:31 - 2:36]))
+                                                                  ('.' [2:36 - 2:37])
+                                                                  ('module_fun' [2:37 - 2:53]
+                                                                     ('field_name' [2:37 - 2:53]
+                                                                        ('ident' [2:37 - 2:53]
+                                                                           ('Name' [2:37 - 2:53])))))
+                                                               ('arguments' [2:54 - 2:57]
+                                                                  ('(' [2:54 - 2:55])
+                                                                  ('expr' [2:55 - 2:56]
+                                                                     ('disj_expr' [2:55 - 2:56]
+                                                                        ('conj_expr' [2:55 - 2:56]
+                                                                           ('set_membership' [2:55 - 2:56]
+                                                                              ('comp_expr' [2:55 - 2:56]
+                                                                                 ('cat_expr' [2:55 - 2:56]
+                                                                                    ('cons_expr' [2:55 - 2:56]
+                                                                                       ('add_expr' [2:55 - 2:56]
+                                                                                          ('mult_expr' [2:55 - 2:56]
+                                                                                             ('unary_expr' [2:55 - 2:56]
+                                                                                                ('core_expr' [2:55 - 2:56]
+                                                                                                   ('ident' [2:55 - 2:56]
+                                                                                                      ('Name' [2:55 - 2:56])))))))))))))
+                                                                  (')' [2:56 - 2:57]))))))))))))))))))
+               (';' [2:57 - 2:58])
+               ('}' [3:1 - 3:2]))
+            ('with' [3:3 - 3:7])
+            ('expr' [3:8 - 3:25]
+               ('disj_expr' [3:8 - 3:25]
+                  ('conj_expr' [3:8 - 3:25]
+                     ('set_membership' [3:8 - 3:25]
+                        ('comp_expr' [3:8 - 3:25]
+                           ('cat_expr' [3:8 - 3:25]
+                              ('cons_expr' [3:8 - 3:25]
+                                 ('add_expr' [3:8 - 3:25]
+                                    ('mult_expr' [3:8 - 3:25]
+                                       ('unary_expr' [3:8 - 3:25]
+                                          ('core_expr' [3:8 - 3:25]
+                                             ('fun_call_or_par_or_projection' [3:8 - 3:25]
+                                                ('fun_call' [3:8 - 3:25]
+                                                   ('module_field' [3:8 - 3:21]
+                                                      ('module_name' [3:8 - 3:13]
+                                                         ('Name_Capital' [3:8 - 3:13]))
+                                                      ('.' [3:13 - 3:14])
+                                                      ('module_fun' [3:14 - 3:21]
+                                                         ('field_name' [3:14 - 3:21]
+                                                            ('ident' [3:14 - 3:21]
+                                                               ('Name' [3:14 - 3:21])))))
+                                                   ('arguments' [3:22 - 3:25]
+                                                      ('(' [3:22 - 3:23])
+                                                      ('expr' [3:23 - 3:24]
+                                                         ('disj_expr' [3:23 - 3:24]
+                                                            ('conj_expr' [3:23 - 3:24]
+                                                               ('set_membership' [3:23 - 3:24]
+                                                                  ('comp_expr' [3:23 - 3:24]
+                                                                     ('cat_expr' [3:23 - 3:24]
+                                                                        ('cons_expr' [3:23 - 3:24]
+                                                                           ('add_expr' [3:23 - 3:24]
+                                                                              ('mult_expr' [3:23 - 3:24]
+                                                                                 ('unary_expr' [3:23 - 3:24]
+                                                                                    ('core_expr' [3:23 - 3:24]
+                                                                                       ('ident' [3:23 - 3:24]
+                                                                                          ('Name' [3:23 - 3:24])))))))))))))
+                                                      (')' [3:24 - 3:25])))))))))))))))))))

tools/lsp/squirrel/stack.yaml

@@ -0,0 +1,70 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-3.5
+# resolver: nightly-2015-09-21
+# resolver: ghc-7.10.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2018-01-01.yaml
+resolver: lts-15.7
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+extra-deps:
+- tree-sitter-0.9.0.0@sha256:4fd054b0a9651df9335c5fa0ffed723924dc4dcf7f2521c031323088ca719b05,3411
+- semantic-source-0.0.2.0@sha256:eac962ed1150d8647e703bc78369ecc4c1912db018e111f4ead8a62ae1a85542,2368
+- lingo-0.3.2.0@sha256:80b9ded65f2ddc0272a2872d9c3fc43c37934accae076d3e547dfc6c6b6e16d3,1899
+- semilattices-0.0.0.4@sha256:333707e460923711d1edbdd02ebe1c3957d4e0808eab9886747b52ee3e443639,1909
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+# extra-deps: []
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.1"
+#
+# Override the architecture used by stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

tools/lsp/squirrel/stack.yaml.lock

@@ -0,0 +1,40 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    hackage: tree-sitter-0.9.0.0@sha256:4fd054b0a9651df9335c5fa0ffed723924dc4dcf7f2521c031323088ca719b05,3411
+    pantry-tree:
+      size: 3765
+      sha256: 6d8711529e12512dadb78eb9ea6854edea9a6e4d87e205d5213df221baf733ad
+  original:
+    hackage: tree-sitter-0.9.0.0@sha256:4fd054b0a9651df9335c5fa0ffed723924dc4dcf7f2521c031323088ca719b05,3411
+- completed:
+    hackage: semantic-source-0.0.2.0@sha256:eac962ed1150d8647e703bc78369ecc4c1912db018e111f4ead8a62ae1a85542,2368
+    pantry-tree:
+      size: 727
+      sha256: f3483c0b1495201bf4067091bfcb6c234d4cdb2068a8fd2edde4b94b3272975d
+  original:
+    hackage: semantic-source-0.0.2.0@sha256:eac962ed1150d8647e703bc78369ecc4c1912db018e111f4ead8a62ae1a85542,2368
+- completed:
+    hackage: lingo-0.3.2.0@sha256:80b9ded65f2ddc0272a2872d9c3fc43c37934accae076d3e547dfc6c6b6e16d3,1899
+    pantry-tree:
+      size: 422
+      sha256: c76e9e74eaa576e33c6f02eb8e26b19cc5fe35c514cce888d851184f91e1c156
+  original:
+    hackage: lingo-0.3.2.0@sha256:80b9ded65f2ddc0272a2872d9c3fc43c37934accae076d3e547dfc6c6b6e16d3,1899
+- completed:
+    hackage: semilattices-0.0.0.4@sha256:333707e460923711d1edbdd02ebe1c3957d4e0808eab9886747b52ee3e443639,1909
+    pantry-tree:
+      size: 801
+      sha256: f3b6dd7ac1fa1b7a259334ff342405263da053af5c115bd86499227e2373d8ec
+  original:
+    hackage: semilattices-0.0.0.4@sha256:333707e460923711d1edbdd02ebe1c3957d4e0808eab9886747b52ee3e443639,1909
+snapshots:
+- completed:
+    size: 491389
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/15/7.yaml
+    sha256: 92ab6303fe20ec928461c82ce0980b4d17c06f4e66205a2967e476474f686c17
+  original: lts-15.7

tools/lsp/squirrel/vendor/parser.c

@@ -0,0 +1 @@
+../../pascaligo/src/parser.c