~tim-ats-d/Postem-markup

74a4f8d7e21123f8e9a78e17e5bd1c26c31bc6d6 — Tim-ats-d 2 years ago c4a14c1
Add newline at the end of unary op application.
10 files changed, 70 insertions(+), 24 deletions(-)

M src/ast/dune
R src/ast/{types.mli => types.ml}
M src/checker/checker.ml
M src/checker/dune
M src/expansion/default.ml
M src/repl.ml
M src/syntax/dune
A src/syntax/parsed_ast.ml
M src/syntax/parsed_ast.mli
M src/syntax/parser.mly
M src/ast/dune => src/ast/dune +3 -1
@@ 1,5 1,7 @@
(library
 (name ast)
 (public_name postem.ast)
 (modules_without_implementation expansion types)
 (modules_without_implementation expansion)
 (preprocess
  (pps ppx_deriving.show sedlex.ppx))
 (libraries common))

R src/ast/types.mli => src/ast/types.ml +1 -1
@@ 1,4 1,4 @@
type doc = expr list
type doc = expr list [@@deriving show]

and expr =
  | Text of string

M src/checker/checker.ml => src/checker/checker.ml +30 -9
@@ 4,6 4,10 @@ module type S = sig
  val check : Syntax.Parsed_ast.t -> (Ast.Types.doc, Err.checker_err) result
end

type state =
  | Expr of Ast.Types.expr
  | Expand of Ast.Types.expr * Ast.Types.expr

module Make (Expsn : Ast.Expansion.S) : S = struct
  open Result



@@ 13,34 17,51 @@ module Make (Expsn : Ast.Expansion.S) : S = struct
         (fun acc expr ->
           let+ grp = acc in
           let+ expr' = pexpr expr in
           Ok (expr' :: grp))
           match expr' with
           | Expr e -> Ok (e :: grp)
           | Expand (e, e') -> Ok (e :: e' :: grp))
         (Ok [])

  and pexpr =
    let open Ast.Types in
    let open Syntax.Parsed_ast in
    function
    | LNewline n -> ok @@ Expr (White n)
    | LText t ->
        let text =
          Option.value ~default:t @@ Ctx.AliasCtx.find_opt Expsn.alias t
        in
        ok @@ Text text
    | LWhite w -> ok @@ White w
    | LUnformat u -> ok @@ Text u
        ok @@ Expr (Text text)
    | LWhite w -> ok @@ Expr (White w)
    | LUnformat u -> ok @@ Expr (Text u)
    | LGroup g ->
        let+ grp =
          List.fold_left
            (fun acc expr ->
              let+ grp' = acc in
              let+ expr' = pexpr expr in
              Ok (expr' :: grp'))
              match expr' with
              | Expr e -> Ok (e :: grp')
              | Expand (e, e') -> Ok (e :: e' :: grp'))
            (Ok []) g
        in
        ok @@ Group (List.rev grp)
    | LUnaryOp { op; group } -> (
        ok @@ Expr (Group (List.rev grp))
    | LUnaryOp { op; group; newline } -> (
        match Ctx.UopCtx.find_opt Expsn.uop op.value with
        | None -> error @@ `UndefinedUop op.loc
        | Some _ ->
        | Some _ -> (
            let+ group = pexpr group in
            ok @@ UnaryOp { op = op.value; group })
            match group with
            | Expr e when newline = "" ->
                ok @@ Expr (UnaryOp { op = op.value; group = e })
            | Expr e ->
                ok
                @@ Expand (UnaryOp { op = op.value; group = e }, White newline)
            | Expand (e, e') when newline = "" ->
                ok @@ Expr (UnaryOp { op = op.value; group = Group [ e; e' ] })
            | Expand (e, e') ->
                ok
                @@ Expand
                     ( UnaryOp { op = op.value; group = Group [ e; e' ] },
                       White newline )))
end

M src/checker/dune => src/checker/dune +2 -0
@@ 1,4 1,6 @@
(library
 (name checker)
 (public_name postem.checker)
 (preprocess
  (pps ppx_deriving.show))
 (libraries ast common syntax))

M src/expansion/default.ml => src/expansion/default.ml +4 -4
@@ 3,13 3,13 @@ let alias = Common.Ctx.AliasCtx.(empty |> add "P" "Postem")
let fmt_title ~nbring ~fmt ~chr text =
  nbring#next;
  let ftext = fmt nbring#get text in
  Printf.sprintf "%s\n%s\n" ftext @@ String.(make (length ftext)) chr
  Printf.sprintf "%s\n%s" ftext @@ String.(make (length ftext)) chr

let underline ~char text =
  Printf.sprintf "%s\n%s\n" text @@ String.(make (length text)) char
  Printf.sprintf "%s\n%s" text @@ String.(make (length text)) char

let quote = Printf.sprintf " █ %s\n"
let conclusion = Printf.sprintf "-> %s\n"
let quote = Printf.sprintf " █ %s"
let conclusion = Printf.sprintf "-> %s"

let uop =
  let module Enum = Enumerate.Builtins in

M src/repl.ml => src/repl.ml +3 -1
@@ 18,6 18,8 @@ module Make (Compiler : Core.Compil_impl.S with type t := string) = struct
        List.rev !input |> String.concat "\n"
        |> Compiler.from_string ~filename:"REPL"
      with
      | Ok output -> print output; launch ()
      | Ok output ->
          print output;
          launch ()
      | Error err -> Common.(prerr_with_exit @@ Err.to_string err))
end

M src/syntax/dune => src/syntax/dune +0 -1
@@ 1,7 1,6 @@
(library
 (name syntax)
 (public_name postem.syntax)
 (modules_without_implementation parsed_ast)
 (libraries ast common menhirLib sedlex)
 (preprocess
  (pps ppx_deriving.show sedlex.ppx))

A src/syntax/parsed_ast.ml => src/syntax/parsed_ast.ml +18 -0
@@ 0,0 1,18 @@
module Lexing = struct
  include Lexing

  let pp_position fmt _t = Format.fprintf fmt "loc"
end

type 'a with_loc = { loc : Lexing.position * Lexing.position; value : 'a }
[@@deriving show]

type t = expr list [@@deriving show]

and expr =
  | LText of string
  | LWhite of string
  | LNewline of string
  | LUnformat of string
  | LGroup of expr list
  | LUnaryOp of { op : string with_loc; group : expr; newline : string }

M src/syntax/parsed_ast.mli => src/syntax/parsed_ast.mli +4 -1
@@ 5,6 5,9 @@ type t = expr list
and expr =
  | LText of string
  | LWhite of string
  | LNewline of string
  | LUnformat of string
  | LGroup of expr list
  | LUnaryOp of { op : string with_loc; group : expr }
  | LUnaryOp of { op : string with_loc; group : expr; newline : string }

val show : t -> string

M src/syntax/parser.mly => src/syntax/parser.mly +5 -6
@@ 24,7 24,7 @@ let document :=
let line :=
  | expr
  | uop_line
  | n=NEWLINE; { LWhite n }
  | n=NEWLINE; { LNewline n }

let expr :=
  | group


@@ 41,11 41,10 @@ let group ==

let unary_op ==
  | op=OP; t=TEXT;
    { LUnaryOp { op = mk_loc $loc(op) op; group = LGroup [ LText t ] } }
    { LUnaryOp { op = mk_loc $loc(op) op; group = LGroup [ LText t ]; newline = "" } }
  | op=OP; group=group;
    { LUnaryOp { op = mk_loc $loc(op) op; group } }
    { LUnaryOp { op = mk_loc $loc(op) op; group; newline = "" } }

let uop_line ==
  | op=OP; WHITE; grp=expr+; NEWLINE;
    { LUnaryOp { op = mk_loc $loc(op) op; group = LGroup grp } }
  (* TODO Add newline *)
  | op=OP; WHITE; grp=expr+; newline=NEWLINE;
    { LUnaryOp { op = mk_loc $loc(op) op; group = LGroup grp; newline } }