fogti/yanais
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

ocaml: start implementing expression parsing

Browse source
This commit is contained in:
Alain Zscheile 2024-02-11 18:59:45 +01:00
parent 9b0f719fe2
commit 5152f2bde0
4 changed files with 100 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
ocaml/lib/locale.ml
View file

@ -35,6 +35,7 @@ module Bare : LocaleT = struct
| XSemiColon -> "semi-colon"
| XPattern -> "pattern"
| XRecord -> "record"
| XRefOf -> "ref-of"
| XSelect -> "selection"
| XString -> "string"
| XIdent -> "identifier"
@ -93,6 +94,7 @@ module En : LocaleT = struct
| XSemiColon -> "semi-colon"
| XPattern -> "pattern"
| XRecord -> "record"
| XRefOf -> "ref-of"
| XSelect -> "selection"
| XString -> "string"
| XIdent -> "identifier"

1
ocaml/libsyntax/lex.ml
View file

@ -110,6 +110,7 @@ let tokens lx () =
| ':' -> Some (l_encap lx DubColon 0)
| ';' -> Some (l_encap lx SemiColon 0)
| '=' -> Some (l_encap lx Assign 0)
| '&' -> Some (l_encap lx RefOf 0)
| '(' -> Some (l_encap lx (Paren Open) 0)
| ')' -> Some (l_encap lx (Paren Close) 0)
| '{' -> Some (l_encap lx (Brace Open) 0)

141
ocaml/libsyntax/syntax.ml
View file

@ -1,9 +1,10 @@
(* unevaluated expressions with no runtime variables *)
type stack_ref = int
open Tys
type stack_ref = int
type sel_ident = loc_span_full * stack_ref
type pattern =
| PatIgnore of loc_span_full
| PatName of tagged_ident
@ -22,11 +23,11 @@ and lambda =
and expr =
| Infer
| ELiteral of Literal.lit
| Use of stack_ref
| Use of sel_ident
| RefOf of sel_ident
| Lambda of lambda
| TyLambda of expr * lambda
| Apply of expr * loc_span_full * expr
| RefOf of expr
| RefTy of stack_ref * expr
| Record of expr record
| TyRecord of expr record
@ -49,12 +50,12 @@ let parse_one ps =
| [] -> None
| (k, s) :: xs -> Some (k, s, { ps with lt = xs; offset = loc_span_end s; })
let got ps tok =
let got tok ps =
match parse_one ps with
| Some (k, s, ps) when k == tok -> Some (s, ps)
| _ -> None
let when_got ps tok thn = Option.map thn (got ps tok)
let when_got tok thn ps = Option.map thn (got tok ps)
let next_in_noeof ps (ctx : error_ctx) =
match parse_one ps with
@ -72,50 +73,58 @@ let require ctx parse_inner ps = match parse_inner ps with
| [] -> { start = ps.offset; length = zero_len }
in Yanais_syntax_err (EExpected ctx, ps.file, sp) |> raise
let env_lookup_opt name ps =
let rec inner names count = match names with
| [] -> None
| x::xs -> if x == name then Some count else inner xs (count + 1)
in inner ps.names 0
let env_lookup name span ps = match env_lookup_opt name ps with
| None -> Yanais_syntax_err (EUnknownIdent name, ps.file, span) |> raise
| Some y -> y
module FieldsReg = Set.Make(String)
module FieldsReg2 = Map.Make(String)
let parse_record (type a) parse_inner ps = when_got ps (Brace Open) (fun (_, ps) -> (
(* note: argument accu is reversed *)
let rec inner (accu: a record) (reg: FieldsReg.t) (ps: parser_env) =
let unexp_eof ps = (
let sp = { start = ps.offset; length = zero_len } in
Yanais_syntax_err (EUnexpectedEof XRecord, ps.file, sp) |> raise
) in
let parse_record (type a) parse_inner = when_got (Brace Open) (fun (_, ps) ->
(* note: argument accu is reversed *)
let rec inner (accu: a record) (reg: FieldsReg.t) (ps: parser_env) =
let unexp_eof ps = (
let sp = { start = ps.offset; length = zero_len } in
Yanais_syntax_err (EUnexpectedEof XRecord, ps.file, sp) |> raise
) in
(* after we maybe got a name *)
let rest ps start mbname =
let (xp, ps) = parse_inner ps in
let full_sp = { start; length = Unsigned.UInt32.of_int (ps.offset - start) } in
match ps.lt with
| [] -> unexp_eof ps
| (SemiColon, sp) :: lt -> (
(* continue *)
let reg = match mbname with
| Some i -> FieldsReg.add i reg
| None -> reg
in
inner (((ps.file, full_sp), mbname, xp)::accu) reg
{ ps with lt; offset = loc_span_end sp; }
)
| (_, sp) :: _ -> Yanais_syntax_err (EExpected XSemiColon, ps.file, sp) |> raise
in
(* recognize a name *)
(* after we maybe got a name *)
let rest ps start mbname =
let (xp, ps) = parse_inner ps in
let full_sp = loc_span_of_start_end start ps.offset in
match ps.lt with
| (Brace Close, s) :: lt -> (List.rev accu, { ps with lt; offset = loc_span_end s; })
| (DotIdent i, s) :: (Assign, _) :: lt -> (
if FieldsReg.find_opt i reg |> Option.is_some then (
Yanais_syntax_err (ERecordDupIdent i, ps.file, s) |> raise
) else
let ps = { ps with lt; offset = loc_span_end s; } in
rest ps s.start (Some i)
)
| [] -> unexp_eof ps
| _ -> rest ps ps.offset None
| (SemiColon, sp) :: lt -> (
(* continue *)
let reg = match mbname with
| Some i -> FieldsReg.add i reg
| None -> reg
in
inner (((ps.file, full_sp), mbname, xp)::accu) reg
{ ps with lt; offset = loc_span_end sp; }
)
| (_, sp) :: _ -> Yanais_syntax_err (EExpected XSemiColon, ps.file, sp) |> raise
in
inner [] FieldsReg.empty ps
))
(* recognize a name *)
match ps.lt with
| (Brace Close, s) :: lt -> (List.rev accu, { ps with lt; offset = loc_span_end s; })
| (DotIdent i, s) :: (Assign, _) :: lt -> (
if FieldsReg.find_opt i reg |> Option.is_some then (
Yanais_syntax_err (ERecordDupIdent i, ps.file, s) |> raise
) else
let ps = { ps with lt; offset = loc_span_end s; } in
rest ps s.start (Some i)
)
| [] -> unexp_eof ps
| _ -> rest ps ps.offset None
in inner [] FieldsReg.empty ps)
let rec pattern_exports stk p = match p with
| PatIgnore _ -> stk
@ -148,11 +157,41 @@ let parse_pattern ps =
| None -> Some (ret, ps)
| Some { ident; file; span; } -> Yanais_syntax_err (EPatternDupIdent ident, file, span) |> raise
(*
let parse_expr ps =
match parse_one ps with
| None -> None
| Some (k, s, ps) -> (
)
*)
(* a minimal expression are all parts which are "self contained" enough (e.g. not an apply) *)
let rec parse_minexpr ps =
let (k, s, ps) = next_in_noeof ps XExpression in
match k with
| Ident i -> (Use ((ps.file, s), env_lookup i s ps), ps)
| RefOf -> (
let (k, s, ps) = next_in_noeof ps XRefOf in
match k with
| Ident i -> (RefOf ((ps.file, s), env_lookup i s ps), ps)
| _ -> Yanais_syntax_err (EUnexpectedToken (XRefOf, k), ps.file, s) |> raise
)
| LLiteral l -> (ELiteral l, ps)
| Paren Open -> (
let (inner, ps) = parse_expr ps in
let (_, ps) = require XParens (got (Paren Close)) ps in
(inner, ps)
)
(*
| Lambda -> (
let (pat, ps) = require XPattern parse_pattern ps in
let (pty, ps) = match parse_ty_annot ps with
| None -> (None, ps)
| Some (s, ptyx, ps) -> (Some (s, ptyx), ps)
in let pmt = (pat, pty) in
let body_span_start = ps.offset in
let (body, ps) = parse_minexpr
)
*)
| _ -> Yanais_syntax_err (EUnexpectedToken (XExpression, k), ps.file, s) |> raise
and parse_ty_annot ps = when_got DubColon (fun (_, ps) ->
let span_start = ps.offset in
let (ptyx, ps) = parse_expr ps in
let span = loc_span_of_start_end span_start ps.offset in
Some ((ps.file, span), ptyx, ps)
) ps
and parse_expr _ = failwith "unimplemented"

7
ocaml/libsyntax/tys.ml
View file

@ -10,6 +10,9 @@ type loc_span_full = string * loc_span
let loc_span_end ls = ls.start + Unsigned.UInt32.to_int ls.length
let loc_span_of_start_end start endx =
{ start; length = Unsigned.UInt32.of_int (endx - start); }
type tagged_ident =
{ ident: string
; file : string
@ -29,6 +32,7 @@ type token =
| DubColon
| SemiColon
| Assign
| RefOf
| LLiteral of Literal.lit
| Ident of string
(* note: PatOut and DotIdent might carry an empty identifier *)
@ -59,6 +63,7 @@ let token_to_string = function
| DubColon -> ":"
| SemiColon -> ";"
| Assign -> "="
| RefOf -> "&"
| LLiteral l -> Literal.to_string l
| Ident x -> x
| PatOut x -> "$" ^ x
@ -82,6 +87,7 @@ type error_ctx =
| XSemiColon
| XPattern
| XRecord
| XRefOf
| XSelect
| XString
| XIdent
@ -96,6 +102,7 @@ let str_of_ectx = function
| XSemiColon -> "semi-colon"
| XPattern -> "pattern"
| XRecord -> "record"
| XRefOf -> "ref-of"
| XSelect -> "selection"
| XString -> "string"
| XIdent -> "identifier"