ocaml: [WIP] TagGroup
This commit is contained in:
parent
d4fddeb596
commit
2a0e85575e
|
@ -38,6 +38,7 @@ module Bare : LocaleT = struct
|
|||
| XRefOf -> "ref-of"
|
||||
| XSelect -> "selection"
|
||||
| XString -> "string"
|
||||
| XTagGroup -> "tag-group"
|
||||
| XIdent -> "identifier"
|
||||
|
||||
let pp_error fmtp (k,file,s) =
|
||||
|
@ -97,6 +98,7 @@ module En : LocaleT = struct
|
|||
| XRefOf -> "ref-of"
|
||||
| XSelect -> "selection"
|
||||
| XString -> "string"
|
||||
| XTagGroup -> "tag group"
|
||||
| XIdent -> "identifier"
|
||||
|
||||
let pp_error fmtp (k,file,s) =
|
||||
|
|
|
@ -93,6 +93,7 @@ let tokens lx () =
|
|||
| "layout" -> Layout
|
||||
| "let" -> Let
|
||||
| "match" -> Match
|
||||
| "tag_group" -> KTagGroup
|
||||
| "\u{03BB}" -> Lambda
|
||||
| "\u{039B}" -> TyLambda (* a large lambda *)
|
||||
| "\u{03BC}" -> Mu
|
||||
|
|
|
@ -33,6 +33,10 @@ let isz_to_str = function
|
|||
| IPow x -> Int.shift_left 1 (Char.code x) |> Int.to_string
|
||||
| ISize -> "_size"
|
||||
|
||||
let isz_to_pow = function
|
||||
| IPow x -> x
|
||||
| ISize -> 16 (* should be a fitting default *)
|
||||
|
||||
let str_post loc s = String.sub s loc (String.length s - loc)
|
||||
|
||||
let of_string = function
|
||||
|
|
31
ocaml/libsyntax/tagGroup.ml
Normal file
31
ocaml/libsyntax/tagGroup.ml
Normal file
|
@ -0,0 +1,31 @@
|
|||
open Tys
|
||||
|
||||
module FieldsReg = Map.Make(String)
|
||||
|
||||
(* a tag group, which has an underlying type, and a bunch of key-index pairs *)
|
||||
type t = loc_span_full * Literal.int_size * (int FieldsReg.t)
|
||||
|
||||
let rev_lookup ival ((_, _, frg): t) =
|
||||
FieldsReg.filter (fun nam -> fun x -> x == ival) frg |> FieldsReg.choose
|
||||
|
||||
let parse_opt ps =
|
||||
let rec inner ps (osp, oisz, frg) = match ps.lt with
|
||||
| (DotIdent nam, s)::(LLiteral Literal.LNatural nat, _)::(SemiColon, s3)::lt ->
|
||||
let ps = { ps with lt; offset = loc_span_end s3; } in
|
||||
(match FieldsReg.find_opt nam frg with
|
||||
| None -> inner ps (osp, isz, FieldsReg.add nam nat frg)
|
||||
| Some x -> Yanais_syntax_err (ERecordDupIdent nam, ps.file, s) |> raise)
|
||||
| (Brace Close, s)::lt ->
|
||||
let ps = { ps with lt; offset = loc_span_end s; } in
|
||||
((osp, oisz, frg), ps)
|
||||
| (k, s)::lt -> Yanais_syntax_err (EExpected XTagGroupItem, ps.file, s) |> raise
|
||||
| [] -> Yanais_syntax_err (EUnexpectedEof XTagGroupItem, ps.file, osp) |> raise
|
||||
|
||||
match ps.lt with
|
||||
| (KTagGroup, s1)::(LLiteral Literal.LIntSize isz, _)::(Brace Open, s3)::lt ->
|
||||
let ps = { ps with lt; offset = loc_span_end s3; } in
|
||||
let acc = ((ps.file, s1), isz, FieldsReg.empty) in
|
||||
Some (inner ps acc)
|
||||
| _ -> None
|
||||
|
||||
let parse ps = require XTagGroup parse_opt ps
|
|
@ -47,6 +47,7 @@ type token =
|
|||
| Layout
|
||||
| Let
|
||||
| Match
|
||||
| KTagGroup
|
||||
|
||||
type token_ann = token * loc_span
|
||||
|
||||
|
@ -76,6 +77,7 @@ let token_to_string = function
|
|||
| Layout -> "layout"
|
||||
| Let -> "let"
|
||||
| Match -> "match"
|
||||
| KTagGroup -> "tag_group"
|
||||
|
||||
type error_ctx =
|
||||
| XComment
|
||||
|
@ -90,6 +92,7 @@ type error_ctx =
|
|||
| XRefOf
|
||||
| XSelect
|
||||
| XString
|
||||
| XTagGroup
|
||||
| XIdent
|
||||
|
||||
let str_of_ectx = function
|
||||
|
@ -105,6 +108,7 @@ let str_of_ectx = function
|
|||
| XRefOf -> "ref-of"
|
||||
| XSelect -> "selection"
|
||||
| XString -> "string"
|
||||
| XTagGroup -> "tag group"
|
||||
| XIdent -> "identifier"
|
||||
|
||||
type error_kind =
|
||||
|
|
Loading…
Reference in a new issue