syndicate-lang
/
preserves
mirror of https://gitlab.com/preserves/preserves.git
1
0
Fork 1
Code Releases Activity

Constrain names/identifiers in schemas to be lowest-common-denominator.

This commit is contained in:
Tony Garnock-Jones 2021-06-25 09:45:07 +02:00
parent da513a249e
commit fdb43f6292
18 changed files with 164 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
implementations/javascript/packages/schema/src/checker.ts
View File

@ -28,9 +28,11 @@ class Checker {
const name = sym.description!;
if (scope.has(name)) {
this.recordProblem(context, `duplicate binding named ${JSON.stringify(name)}`);
} else {
scope.add(name);
}
if (!M.isValidToken(name)) {
this.recordProblem(context, `invalid binding name ${JSON.stringify(name)}`);
}
scope.add(name);
}
checkDefinition(def: M.Definition, name: symbol): void {
@ -42,6 +44,9 @@ class Checker {
if (labels.has(variantLabel)) {
this.recordProblem(context, `duplicate variant label`);
}
if (!M.isValidToken(variantLabel)) {
this.recordProblem(context, `invalid variant label`);
}
labels.add(variantLabel);
this.checkPattern(new Set(), pattern, context, ValueAvailability.AVAILABLE);
});
@ -87,6 +92,12 @@ class Checker {
if (p.value._variant !== 'lit' && availability === ValueAvailability.NOT_AVAILABLE) {
this.recordProblem(context, 'cannot recover serialization of non-literal pattern');
}
if (p.value._variant === 'Ref' &&
!(M.isValidToken(p.value.value.name.description!) &&
p.value.value.module.every(n => M.isValidToken(n.description!))))
{
this.recordProblem(context, 'invalid reference name');
}
break;
case 'CompoundPattern':
((p: M.CompoundPattern): void => {
@ -99,7 +110,7 @@ class Checker {
p.patterns.forEach((pp, i) =>
this.checkNamedPattern(scope, pp, `item ${i} of ${context}`));
break;
case 'tuple*':
case 'tuplePrefix':
p.fixed.forEach((pp, i) =>
this.checkNamedPattern(scope, pp, `item ${i} of ${context}`));
this.checkNamedPattern(

2
implementations/javascript/packages/schema/src/compiler/genconverter.ts
View File

@ -210,7 +210,7 @@ function converterForCompound(
converterFor(ctx, p.fields, src, ks, true))))];
case 'tuple':
return converterForTuple(ctx, p.patterns, src, knownArray, void 0, ks);
case 'tuple*':
case 'tuplePrefix':
return converterForTuple(ctx, p.fixed, src, knownArray, p.variable, ks);
case 'dict': {
const entries = Array.from(p.entries);

2
implementations/javascript/packages/schema/src/compiler/gentype.ts
View File

@ -71,7 +71,7 @@ function compoundFields(fs: FieldMap, resolver: RefResolver, p: M.CompoundPatter
case 'tuple':
p.patterns.forEach(pp => gatherFields(fs, resolver, pp));
break;
case 'tuple*':
case 'tuplePrefix':
p.fixed.forEach(pp => gatherFields(fs, resolver, pp));
gatherFields(fs, resolver, M.promoteNamedSimplePattern(p.variable));
break;

2
implementations/javascript/packages/schema/src/compiler/genunconverter.ts
View File

@ -85,7 +85,7 @@ function unconverterFor(ctx: FunctionContext, p: M.Pattern, src: string): Item {
case 'tuple':
return brackets(... p.patterns.map(pp =>
unconverterForNamed(ctx, pp, src)));
case 'tuple*': {
case 'tuplePrefix': {
const varExp =
unconverterForNamed(ctx, M.promoteNamedSimplePattern(p.variable), src);
if (p.fixed.length === 0) {

14
implementations/javascript/packages/schema/src/gen/schema.ts
View File

@ -26,7 +26,7 @@ export const $schema = Symbol.for("schema");
export const $seqof = Symbol.for("seqof");
export const $setof = Symbol.for("setof");
export const $tuple = Symbol.for("tuple");
export const $tuple$STAR$ = Symbol.for("tuple*");
export const $tuplePrefix = Symbol.for("tuplePrefix");
export const $version = Symbol.for("version");
export const __lit6 = false;
@ -86,7 +86,7 @@ export type CompoundPattern = (
{"_variant": "rec", "label": NamedPattern, "fields": NamedPattern} |
{"_variant": "tuple", "patterns": Array<NamedPattern>} |
{
"_variant": "tuple*",
"_variant": "tuplePrefix",
"fixed": Array<NamedPattern>,
"variable": NamedSimplePattern
} |
@ -190,7 +190,7 @@ export namespace SimplePattern {
export namespace CompoundPattern {
export function rec({label, fields}: {label: NamedPattern, fields: NamedPattern}): CompoundPattern {return {"_variant": "rec", "label": label, "fields": fields};};
export function tuple(patterns: Array<NamedPattern>): CompoundPattern {return {"_variant": "tuple", "patterns": patterns};};
export function tuple$STAR$({fixed, variable}: {fixed: Array<NamedPattern>, variable: NamedSimplePattern}): CompoundPattern {return {"_variant": "tuple*", "fixed": fixed, "variable": variable};};
export function tuplePrefix({fixed, variable}: {fixed: Array<NamedPattern>, variable: NamedSimplePattern}): CompoundPattern {return {"_variant": "tuplePrefix", "fixed": fixed, "variable": variable};};
export function dict(entries: DictionaryEntries): CompoundPattern {return {"_variant": "dict", "entries": entries};};
}
@ -685,7 +685,7 @@ export function toCompoundPattern(v: _val): undefined | CompoundPattern {
if (result === void 0) {
if (_.Record.isRecord<_val, _.Tuple<_val>, _embedded>(v)) {
let _tmp7: (null) | undefined;
_tmp7 = _.is(v.label, $tuple$STAR$) ? null : void 0;
_tmp7 = _.is(v.label, $tuplePrefix) ? null : void 0;
if (_tmp7 !== void 0) {
let _tmp8: (Array<NamedPattern>) | undefined;
_tmp8 = void 0;
@ -702,7 +702,7 @@ export function toCompoundPattern(v: _val): undefined | CompoundPattern {
if (_tmp8 !== void 0) {
let _tmp11: (NamedSimplePattern) | undefined;
_tmp11 = toNamedSimplePattern(v[1]);
if (_tmp11 !== void 0) {result = {"_variant": "tuple*", "fixed": _tmp8, "variable": _tmp11};};
if (_tmp11 !== void 0) {result = {"_variant": "tuplePrefix", "fixed": _tmp8, "variable": _tmp11};};
};
};
};
@ -728,9 +728,9 @@ export function fromCompoundPattern(_v: CompoundPattern): _val {
return _.Record($rec, [fromNamedPattern(_v["label"]), fromNamedPattern(_v["fields"])]);
};
case "tuple": {return _.Record($tuple, [_v["patterns"].map(v => fromNamedPattern(v))]);};
case "tuple*": {
case "tuplePrefix": {
return _.Record(
$tuple$STAR$,
$tuplePrefix,
[
_v["fixed"].map(v => fromNamedPattern(v)),
fromNamedSimplePattern(_v["variable"])

11
implementations/javascript/packages/schema/src/meta.ts
View File

@ -7,16 +7,25 @@ export * from './gen/schema';
export type Input = M._val;
export function qidLast(s: string): string {
const m = s.match(/^(.*\.)?([^.]+)$/);
return m![2];
}
export function isValidToken(s: string): boolean {
return /^[a-zA-Z][a-zA-Z_0-9]*$/.test(s);
}
export function isValidQid(s: string): boolean {
return s.split('.').every(isValidToken);
}
export function isValidJsId(s: string): boolean {
return /^[$_a-zA-Z][$_a-zA-Z0-9]*$/.test(s) && !isJsKeyword(s);
}
export function jsId(v: string, kf?: () => string): string {
return jsToken(v.replace('$', '$$').replace('*', '$STAR$'), kf);
return jsToken(v.replace('$', '$$'), kf);
}
export function jsToken(s: string, kf?: () => string): string {

31
implementations/javascript/packages/schema/src/reader.ts
View File

@ -93,7 +93,7 @@ export function parseSchema(toplevelTokens: Array<Input>, options: SchemaReaderO
const stx = peel(clause[1]);
if (stx === false) {
embeddedType = M.EmbeddedTypeName.$false();
} else if (typeof stx === 'symbol') {
} else if (typeof stx === 'symbol' && M.isValidQid(stx.description!)) {
embeddedType = M.EmbeddedTypeName.Ref(parseRef(stx.description!, pos));
} else {
invalidPattern('embedded type name specification', stx, pos);
@ -140,7 +140,8 @@ function parseDefinition(name: symbol, pos: Position | null, body: Array<Input>)
p.value.label._variant === 'anonymous' &&
p.value.label.value._variant === 'SimplePattern' &&
p.value.label.value.value._variant === 'lit' &&
typeof p.value.label.value.value.value === 'symbol')
typeof p.value.label.value.value.value === 'symbol' &&
M.isValidToken(p.value.label.value.value.value.description!))
{
return M.NamedAlternative({
variantLabel: p.value.label.value.value.value.description!,
@ -148,10 +149,11 @@ function parseDefinition(name: symbol, pos: Position | null, body: Array<Input>)
});
}
if (p._variant === 'SimplePattern' &&
p.value._variant === 'Ref')
p.value._variant === 'Ref' &&
M.isValidQid(p.value.value.name.description!))
{
return M.NamedAlternative({
variantLabel: p.value.value.name.description!,
variantLabel: M.qidLast(p.value.value.name.description!),
pattern: p
});
}
@ -224,9 +226,15 @@ function parsePattern(name: symbol, body0: Array<Input>): Pattern {
case 'string': return ks(M.SimplePattern.atom(M.AtomKind.String()));
case 'bytes': return ks(M.SimplePattern.atom(M.AtomKind.ByteString()));
case 'symbol': return ks(M.SimplePattern.atom(M.AtomKind.Symbol()));
default: return ks((str[0] === '=')
? M.SimplePattern.lit(Symbol.for(str.slice(1)))
: M.SimplePattern.Ref(parseRef(str, pos)));
default: {
if (str[0] === '=') {
return ks(M.SimplePattern.lit(Symbol.for(str.slice(1))));
} else if (M.isValidQid(str)) {
return ks(M.SimplePattern.Ref(parseRef(str, pos)));
} else {
complain();
}
}
}
} else if (Record.isRecord<Input, Tuple<Input>, M._embedded>(item)) {
const label = item.label;
@ -294,7 +302,7 @@ function parsePattern(name: symbol, body0: Array<Input>): Pattern {
const variableTemplateInput = item[item.length - 2];
const variablePart =
transferAnnotations([variableTemplateInput, M.DOTDOTDOT], variableTemplateInput);
return M.CompoundPattern.tuple$STAR$({
return M.CompoundPattern.tuplePrefix({
fixed: item.slice(0, item.length - 2).map(maybeNamed),
variable: maybeNamedSimple(variablePart),
});
@ -330,7 +338,10 @@ function parsePattern(name: symbol, body0: Array<Input>): Pattern {
return (b: Input) => {
let name = findName(b);
if (name === false) {
if (literalName !== void 0 && typeof literalName === 'symbol') {
if (literalName !== void 0 &&
typeof literalName === 'symbol' &&
M.isValidToken(literalName.description!))
{
name = literalName;
}
}
@ -358,7 +369,7 @@ function findName(x: Input): symbol | false {
if (!Annotated.isAnnotated<never>(x)) return false;
for (const a0 of x.annotations) {
const a = peel(a0);
if (typeof a === 'symbol') return a;
if (typeof a === 'symbol') return M.isValidToken(a.description!) && a;
}
return false;
}

24
implementations/racket/preserves/preserves-schema/checker.rkt
View File

@ -1,7 +1,8 @@
#lang racket/base
(provide schema-check-problems
schema-check-problems!)
schema-check-problems!
valid-id?)
(require racket/match)
(require (only-in racket/list check-duplicates))
@ -11,6 +12,10 @@
(require (only-in "type.rkt" unwrap))
(require "gen/schema.rkt")
(define (valid-id? x)
(and (symbol? x)
(regexp-match? #px"^[a-zA-Z][a-zA-Z_0-9]*$" (symbol->string x))))
(define (schema-check-problems schema)
(define problems '())
@ -20,20 +25,27 @@
(define (check-binding context scope n)
(when (hash-has-key? scope n)
(problem! context "duplicate binding ~v" n))
(when (not (valid-id? n))
(problem! context "invalid binding name ~v" n))
(hash-set! scope n #t))
(define (check-pattern context scope p value-available?)
(match (unwrap p)
[(SimplePattern-lit _)
(void)]
[(? SimplePattern?)
(when (not value-available?) (problem! context "necessary information not captured"))]
[(? SimplePattern? u)
(when (not value-available?) (problem! context "necessary information not captured"))
(match u
[(SimplePattern-Ref (Ref (ModulePath ids) id))
(when (not (andmap valid-id? (cons id ids)))
(problem! context "invalid reference name"))]
[_ (void)])]
[(CompoundPattern-rec l f)
(check-named-pattern (cons "label" context) scope l)
(check-named-pattern (cons "fields" context) scope f)]
[(CompoundPattern-tuple ps)
(for [(p (in-list ps)) (i (in-naturals))] (check-named-pattern (cons i context) scope p))]
[(CompoundPattern-tuple* ps v)
[(CompoundPattern-tuplePrefix ps v)
(for [(p (in-list ps)) (i (in-naturals))] (check-named-pattern (cons i context) scope p))
(check-named-pattern (cons "tail" context) scope v)]
[(CompoundPattern-dict (DictionaryEntries entries))
@ -55,7 +67,9 @@
(unless (void? (check-duplicates alts #:key NamedAlternative-variantLabel #:default (void)))
(problem! context "duplicate variant label"))
(for [(a (in-list alts))]
(check-pattern context (make-hash) (NamedAlternative-pattern a) #t))]
(define label (string->symbol (NamedAlternative-variantLabel a)))
(when (not (valid-id? label)) (problem! context "invalid variant label ~v" label))
(check-pattern (cons label context) (make-hash) (NamedAlternative-pattern a) #t))]
[(Definition-and p0 p1 pN)
(define scope (make-hash))
(for [(p (in-list (list* p0 p1 pN)))]

2
implementations/racket/preserves/preserves-schema/compiler.rkt
View File

@ -73,7 +73,7 @@
(walk fields-named-pat)]
[(CompoundPattern-tuple named-pats)
(for-each walk named-pats)]
[(CompoundPattern-tuple* fixed-named-pats variable-named-pat)
[(CompoundPattern-tuplePrefix fixed-named-pats variable-named-pat)
(for-each walk fixed-named-pats)
(walk variable-named-pat)]
[(CompoundPattern-dict (DictionaryEntries entries))

28
implementations/racket/preserves/preserves-schema/gen/schema.rkt
View File

@ -120,7 +120,7 @@
(define (CompoundPattern? p)
(or (CompoundPattern-rec? p)
(CompoundPattern-tuple? p)
(CompoundPattern-tuple*? p)
(CompoundPattern-tuplePrefix? p)
(CompoundPattern-dict? p)))
(struct
CompoundPattern-rec
@ -150,7 +150,7 @@
(list
(for/list ((item (in-list ?patterns))) (*->preserve item)))))))))
(struct
CompoundPattern-tuple*
CompoundPattern-tuplePrefix
(fixed variable)
#:transparent
#:methods
@ -159,9 +159,9 @@
(define (->preserve preservable)
(match
preservable
((CompoundPattern-tuple* ?fixed ?variable)
((CompoundPattern-tuplePrefix ?fixed ?variable)
(record
'tuple*
'tuplePrefix
(list
(for/list ((item (in-list ?fixed))) (*->preserve item))
(*->preserve ?variable))))))))
@ -197,11 +197,11 @@
(CompoundPattern-tuple ?patterns))
((and dest
(record
'tuple*
'tuplePrefix
(list
(list (app parse-NamedPattern (and ?fixed (not (== eof)))) ...)
(app parse-NamedSimplePattern (and ?variable (not (== eof)))))))
(CompoundPattern-tuple* ?fixed ?variable))
(CompoundPattern-tuplePrefix ?fixed ?variable))
((and dest
(record
'dict
@ -300,7 +300,7 @@
((Definitions src)
(for/hash
(((key value) (in-dict src)))
(values key (*->preserve value))))))))
(values (*->preserve key) (*->preserve value))))))))
(define (parse-Definitions input)
(match
input
@ -330,7 +330,7 @@
((DictionaryEntries src)
(for/hash
(((key value) (in-dict src)))
(values key (*->preserve value))))))))
(values (*->preserve key) (*->preserve value))))))))
(define (parse-DictionaryEntries input)
(match
input
@ -383,7 +383,8 @@
(define (->preserve preservable)
(match
preservable
((ModulePath src) (for/list ((item (in-list src))) item))))))
((ModulePath src)
(for/list ((item (in-list src))) (*->preserve item)))))))
(define (parse-ModulePath input)
(match
input
@ -431,7 +432,7 @@
(match
preservable
((NamedAlternative ?variantLabel ?pattern)
(list ?variantLabel (*->preserve ?pattern)))))))
(list (*->preserve ?variantLabel) (*->preserve ?pattern)))))))
(define (parse-NamedAlternative input)
(match
input
@ -518,7 +519,7 @@
(match
preservable
((NamedSimplePattern_ ?name ?pattern)
(record 'named (list ?name (*->preserve ?pattern))))))))
(record 'named (list (*->preserve ?name) (*->preserve ?pattern))))))))
(define (parse-NamedSimplePattern_ input)
(match
input
@ -574,7 +575,7 @@
(match
preservable
((Ref ?module ?name)
(record 'ref (list (*->preserve ?module) ?name)))))))
(record 'ref (list (*->preserve ?module) (*->preserve ?name))))))))
(define (parse-Ref input)
(match
input
@ -678,7 +679,8 @@
(define (->preserve preservable)
(match
preservable
((SimplePattern-lit ?value) (record 'lit (list ?value)))))))
((SimplePattern-lit ?value)
(record 'lit (list (*->preserve ?value))))))))
(struct
SimplePattern-seqof
(pattern)

2
implementations/racket/preserves/preserves-schema/parser.rkt
View File

@ -60,7 +60,7 @@
[(CompoundPattern-tuple named-pats)
(maybe-dest dest-pat-stx
`(list ,@(map (lambda (p) (pattern->match-pattern p '_)) named-pats)))]
[(CompoundPattern-tuple* fixed-named-pats variable-named-pat)
[(CompoundPattern-tuplePrefix fixed-named-pats variable-named-pat)
(maybe-dest dest-pat-stx
(if (null? fixed-named-pats)
(pattern->match-pattern variable-named-pat '_)

55
implementations/racket/preserves/preserves-schema/reader.rkt
View File

@ -11,7 +11,7 @@
(require (only-in racket/string string-split))
(require preserves)
(require (only-in "type.rkt" namelike))
(require (only-in "checker.rkt" valid-id?))
(require "gen/schema.rkt")
(define (split-by items separator)
@ -44,7 +44,7 @@
(set! version (parse-Version! (strip-annotations v)))]
[`(,(peel-annotations 'embeddedType) ,(peel-annotations #f))
(set! embeddedType (EmbeddedTypeName-false))]
[`(,(peel-annotations 'embeddedType) ,(peel-annotations (? symbol? r)))
[`(,(peel-annotations 'embeddedType) ,(peel-annotations (? valid-qid? r)))
(set! embeddedType (EmbeddedTypeName-Ref (parse-ref-dsl r)))]
[`(,(peel-annotations 'include) ,(peel-annotations (? string? path)))
(when (not read-include)
@ -54,7 +54,7 @@
[(not source) (error 'parse-schema-dsl "Cannot resolve relative include path")]
[else (simplify-path (build-path source 'up path) #f)]))
(process (read-include new-source) new-source)]
[`(,(peel-annotations (? symbol? name)) ,(peel-annotations '=) ,@def-stx)
[`(,(peel-annotations (? valid-id? name)) ,(peel-annotations '=) ,@def-stx)
(when (hash-has-key? definitions name)
(error 'parse-schema-dsl "Duplicate definition: ~a" name))
(hash-set! definitions name (parse-def-dsl name def-stx))]
@ -64,11 +64,28 @@
(when (not version) (error 'parse-schema "Missing version declaration"))
(Schema (Definitions definitions) embeddedType version))
(define (symbol-pieces s)
(map string->symbol (string-split (symbol->string s) ".")))
(define (valid-qid? x)
(and (symbol? x)
(andmap valid-id? (symbol-pieces x))))
(define (qid-last n)
(car (reverse (symbol-pieces n))))
(define (parse-ref-dsl s)
(match-define (list module-path ... final-id)
(map string->symbol (string-split (symbol->string s) ".")))
(match-define (list module-path ... final-id) (symbol-pieces s))
(Ref (ModulePath module-path) final-id))
(define (namelike v)
(match v
[(? string? s) (string->symbol s)]
[(? symbol? s) s]
[(? number? n) (string->symbol (number->string n))]
[(? boolean? b) (if b 'true 'false)]
[_ #f]))
(define (parse-def-dsl name def-stx)
(define (and-branch input)
(define p (parse-pattern-dsl name input))
@ -88,12 +105,12 @@
(CompoundPattern-rec
(NamedPattern-anonymous
(Pattern-SimplePattern
(SimplePattern-lit (? symbol? n))))
(SimplePattern-lit (? valid-id? n))))
_))
(NamedAlternative (symbol->string n) p)]
[(Pattern-SimplePattern (SimplePattern-Ref (Ref _ n)))
(NamedAlternative (symbol->string n) p)]
[(Pattern-SimplePattern (SimplePattern-lit (app namelike (? symbol? n))))
[(Pattern-SimplePattern (SimplePattern-Ref (Ref _ (? valid-qid? n))))
(NamedAlternative (symbol->string (qid-last n)) p)]
[(Pattern-SimplePattern (SimplePattern-lit (app namelike (? valid-id? n))))
(NamedAlternative (symbol->string n) p)]
[_
(error 'parse-def-dsl "Name missing for alternative: ~a" (input->string input))])]))
@ -123,9 +140,13 @@
['symbol (ks (SimplePattern-atom (AtomKind-Symbol)))]
[(? symbol? sym)
(define str (symbol->string sym))
(if (and (> (string-length str) 0) (string=? (substring str 0 1) "="))
(ks (SimplePattern-lit (string->symbol (substring str 1))))
(ks (SimplePattern-Ref (parse-ref-dsl sym))))]
(cond
[(and (> (string-length str) 0) (string=? (substring str 0 1) "="))
(ks (SimplePattern-lit (string->symbol (substring str 1))))]
[(valid-qid? sym)
(ks (SimplePattern-Ref (parse-ref-dsl sym)))]
[else
(error 'parse-simple-dsl "Invalid schema name reference: ~a" sym)])]
[(strip-annotations (record (record 'lit '()) lit-pat))
(match lit-pat
[(list v) (ks (SimplePattern-lit v))]
@ -152,9 +173,9 @@
(CompoundPattern-rec (NamedPattern-anonymous (Pattern-SimplePattern (SimplePattern-lit label)))
(NamedPattern-anonymous (walk fields)))]
[(list fixed ... variable (peel-annotations '...))
(CompoundPattern-tuple* (map maybe-named fixed)
(maybe-named-simple
(apply annotate (list variable '...) (annotations variable))))]
(CompoundPattern-tuplePrefix (map maybe-named fixed)
(maybe-named-simple
(apply annotate (list variable '...) (annotations variable))))]
[(list item ...)
(CompoundPattern-tuple (map maybe-named item))]
[(? dict? d) #:when (not (dict-has-key? (strip-annotations d) '...))
@ -175,7 +196,7 @@
(define ((maybe-named* knamed kanonymous recur [literal-name #f]) b)
(define n (or (find-name b)
(and (symbol? literal-name) literal-name)))
(and (valid-id? literal-name) literal-name)))
(if n
(let ((p (parse-simple-dsl
b
@ -198,7 +219,7 @@
(lambda () (Pattern-CompoundPattern (parse-compound-dsl (car input)))))))
(define (find-name input)
(findf symbol? (map peel-annotations (annotations input))))
(findf valid-id? (map peel-annotations (annotations input))))
(define (port->schema src [p (current-input-port)])
(parse-schema-dsl (port->preserves p

6
implementations/racket/preserves/preserves-schema/schema.prs
View File

@ -47,7 +47,7 @@ SimplePattern =
; =symbol, <<lit> any>, or plain non-symbol atom
/ <lit @value any>
; [p ...] ----> <seqof <ref p>>; see also tuple* below.
; [p ...] ----> <seqof <ref p>>; see also tuplePrefix below.
/ <seqof @pattern SimplePattern>
; #{p} ----> <setof <ref p>>
@ -69,9 +69,9 @@ CompoundPattern =
; [a b c] ----> <tuple [<ref a> <ref b> <ref c>]>
/ <tuple @patterns [NamedPattern ...]>
; [a b c ...] ----> <tuple* [<ref a> <ref b>] <seqof <ref c>>>
; [a b c ...] ----> <tuplePrefix [<ref a> <ref b>] <seqof <ref c>>>
; TODO: [@fixed0 NamedPattern @fixedN NamedPattern ...]
/ <tuple* @fixed [NamedPattern ...] @variable NamedSimplePattern>
/ <tuplePrefix @fixed [NamedPattern ...] @variable NamedSimplePattern>
; {a: b, c: d} ----> <dict {a: <ref b>, c: <ref d>}>
/ <dict @entries DictionaryEntries>

11
implementations/racket/preserves/preserves-schema/type.rkt
View File

@ -13,7 +13,6 @@
definition-ty
unwrap
namelike
escape
module-path-prefix)
@ -76,7 +75,7 @@
(gather-fields label-named-pat (gather-fields fields-named-pat acc))]
[(CompoundPattern-tuple named-pats)
(gather-fields* named-pats acc)]
[(CompoundPattern-tuple* fixed-named-pats variable-named-pat)
[(CompoundPattern-tuplePrefix fixed-named-pats variable-named-pat)
(gather-fields* fixed-named-pats (gather-fields variable-named-pat acc))]
[(CompoundPattern-dict (DictionaryEntries entries))
(gather-fields* (map cdr (sorted-dict-entries entries)) acc)]))
@ -93,14 +92,6 @@
[(SimplePattern-Ref _r) (ty-value)]
[(? CompoundPattern?) (product-ty (list p))]))
(define (namelike v)
(match v
[(? string? s) (string->symbol s)]
[(? symbol? s) s]
[(? number? n) (string->symbol (number->string n))]
[(? boolean? b) (if b 'true 'false)]
[_ #f]))
(define (escape s)
(format-symbol "?~a" s))

2
implementations/racket/preserves/preserves-schema/unparser.rkt
View File

@ -33,7 +33,7 @@
`(record ,(pattern->unparser label-pat src-stx) ,(pattern->unparser fields-pat src-stx))]
[(CompoundPattern-tuple named-pats)
`(list ,@(for/list [(p (in-list named-pats))] (pattern->unparser p src-stx)))]
[(CompoundPattern-tuple* fixed-named-pats variable-named-pat)
[(CompoundPattern-tuplePrefix fixed-named-pats variable-named-pat)
`(list* ,@(for/list [(p (in-list fixed-named-pats))] (pattern->unparser p src-stx))
,(pattern->unparser variable-named-pat src-stx))]
[(CompoundPattern-dict (DictionaryEntries entries))

42
preserves-schema.md
View File

@ -4,7 +4,7 @@ title: "Preserves Schema"
---
Tony Garnock-Jones <tonyg@leastfixedpoint.com>
May 2021. Version 0.1.0.
June 2021. Version 0.1.1.
[abnf]: https://tools.ietf.org/html/rfc7405
@ -119,7 +119,7 @@ A bundle of schema files is a directory tree containing `.prs` files.
Version = "version" "1"
EmbeddedTypeName = "embeddedType" ("#f" / Ref)
Include = "include" string
Definition = symbol "=" (OrPattern / AndPattern / Pattern)
Definition = id "=" (OrPattern / AndPattern / Pattern)
**Version specification.** Mandatory. Names the version of the schema
language used in the file. This version of the specification is
@ -155,11 +155,11 @@ Each alternative with an `OrPattern` must have a definition-unique
discussion of `NamedPattern` below) or inferred. It can only be
inferred from the label of a record pattern, from the name of a
reference to another definition, or from the text of a "sufficiently
stringlike" literal pattern - one that matches a string, symbol,
identifierlike" literal pattern - one that matches a string, symbol,
number or boolean:
AltPattern = "@" symbol SimplePattern
/ "<" symbol *(NamedPattern) ">"
AltPattern = "@" id SimplePattern
/ "<" id *(NamedPattern) ">"
/ Ref
/ LiteralPattern -- with a side condition
@ -200,7 +200,7 @@ completely clear.
Patterns come in two kinds:
- the parsers for *simple patterns* yield a single host-language
value such as a string, number, or pointer.
value; for example, a string, an array, a pointer, and so on.
- the parsers for *compound patterns* yield zero or more *fields*
which combine into an overall record type associated with a
@ -258,6 +258,9 @@ Periods "`.`" in such symbols are special:
- `Name` refers to the definition named `Name` in the current schema.
- `Mod.Submod.Name` refers to definition `Name` in `Mod.Submod`, some other schema in the bundle.
Each period-separated portion of a reference name must be an `id`, an
identifier.
[^interface-schema]: Embedded patterns are experimental. One
interpretation is that an embedded value denotes a reference to
some stateful actor in a potentially-distributed system, and that
@ -299,19 +302,24 @@ that symbol is used as the name for that dictionary entry.
DictionaryPattern = "{" *(value ":" NamedSimplePattern) "}"
### Bindings: NamedPattern and NamedSimplePattern
### Identifiers and Bindings: NamedPattern and NamedSimplePattern
Compound patterns specifications contain `NamedPattern`s or
`NamedSimplePattern`s rather than ordinary `Pattern`s:
NamedPattern = "@" symbol SimplePattern / Pattern
NamedSimplePattern = "@" symbol SimplePattern / SimplePattern
NamedPattern = "@" id SimplePattern / Pattern
NamedSimplePattern = "@" id SimplePattern / SimplePattern
Use of an `@name` prefix generally results in creation of a field with
the given name in the overall record type for a definition. The type
of value contained in the field will correspond to the `Pattern` or
`SimplePattern` given.
An `id` is a symbol that matches the regular expression
`^[a-zA-Z][a-zA-Z_0-9]*$`. This is a lowest-common-denominator
constraint that allows for a reasonable mapping to the identifiers of
many programming languages.
## Appendix: Metaschema
The metaschema defines the structure of the abstract syntax (AST) of
@ -388,7 +396,7 @@ Simple patterns are as described above:
; =symbol, <<lit> any>, or plain non-symbol atom
/ <lit @value any>
; [p ...] ----> <seqof <ref p>>; see also tuple* below.
; [p ...] ----> <seqof <ref p>>; see also tuplePrefix below.
/ <seqof @pattern SimplePattern>
; #{p} ----> <setof <ref p>>
@ -420,8 +428,8 @@ Compound patterns involve optionally-named subpatterns:
; [a b c] ----> <tuple [<ref a> <ref b> <ref c>]>
/ <tuple @patterns [NamedPattern ...]>
; [a b c ...] ----> <tuple* [<ref a> <ref b>] <seqof <ref c>>>
/ <tuple* @fixed [NamedPattern ...] @variable NamedSimplePattern>
; [a b c ...] ----> <tuplePrefix [<ref a> <ref b>] <seqof <ref c>>>
/ <tuplePrefix @fixed [NamedPattern ...] @variable NamedSimplePattern>
; {a: b, c: d} ----> <dict {a: <ref b>, c: <ref d>}>
/ <dict @entries DictionaryEntries>
@ -462,7 +470,7 @@ metaschema.
<named fields <ref [] NamedPattern>>
]>>],
["tuple", <rec <lit tuple> <tuple [<named patterns <seqof <ref [] NamedPattern>>>]>>],
["tuple*", <rec <lit tuple*> <tuple [
["tuplePrefix", <rec <lit tuplePrefix> <tuple [
<named fixed <seqof <ref [] NamedPattern>>>,
<named variable <ref [] NamedSimplePattern>>
]>>],
@ -484,11 +492,11 @@ metaschema.
]>>,
Definition: <or [
["or", <rec <lit or> <tuple [<tuple* [
["or", <rec <lit or> <tuple [<tuplePrefix [
<named pattern0 <ref [] NamedAlternative>>,
<named pattern1 <ref [] NamedAlternative>>
] <named patternN <seqof <ref [] NamedAlternative>>>>]>>],
["and", <rec <lit and> <tuple [<tuple* [
["and", <rec <lit and> <tuple [<tuplePrefix [
<named pattern0 <ref [] NamedPattern>>,
<named pattern1 <ref [] NamedPattern>>
] <named patternN <seqof <ref [] NamedPattern>>>>]>>],
@ -621,7 +629,7 @@ definitions for the metaschema.
{"_variant": "rec", "label": NamedPattern, "fields": NamedPattern} |
{"_variant": "tuple", "patterns": Array<NamedPattern>} |
{
"_variant": "tuple*",
"_variant": "tuplePrefix",
"fixed": Array<NamedPattern>,
"variable": NamedSimplePattern
} |
@ -671,7 +679,7 @@ definitions for the metaschema.
(struct Bundle (modules) #:prefab)
(struct CompoundPattern-dict (entries) #:prefab)
(struct CompoundPattern-tuple* (fixed variable) #:prefab)
(struct CompoundPattern-tuplePrefix (fixed variable) #:prefab)
(struct CompoundPattern-tuple (patterns) #:prefab)
(struct CompoundPattern-rec (label fields) #:prefab)

4
schema/schema.bin
View File

@ -3,6 +3,6 @@ ModulePath
ModulePath„´³refµ„³Schema„„³Pattern´³orµµ± SimplePattern´³refµ„³ SimplePattern„„µ±CompoundPattern´³refµ„³CompoundPattern„„„„³Version´³lit‘„³AtomKind´³orµµ±Boolean´³lit³Boolean„„µ±Float´³lit³Float„„µ±Double´³lit³Double„„µ± SignedInteger´³lit³ SignedInteger„„µ±String´³lit³String„„µ±
ByteString´³lit³
ByteString„„µ±Symbol´³lit³Symbol„„„„³
Definition´³orµµ±or´³rec´³lit³or„´³tupleµ´³tuple*µ´³named³pattern0´³refµ„³NamedAlternative„„´³named³pattern1´³refµ„³NamedAlternative„„„´³named³patternN´³seqof´³refµ„³NamedAlternative„„„„„„„„µ±and´³rec´³lit³and„´³tupleµ´³tuple*µ´³named³pattern0´³refµ„³ NamedPattern„„´³named³pattern1´³refµ„³ NamedPattern„„„´³named³patternN´³seqof´³refµ„³ NamedPattern„„„„„„„„µ±Pattern´³refµ„³Pattern„„„„³
Definition´³orµµ±or´³rec´³lit³or„´³tupleµ´³ tuplePrefixµ´³named³pattern0´³refµ„³NamedAlternative„„´³named³pattern1´³refµ„³NamedAlternative„„„´³named³patternN´³seqof´³refµ„³NamedAlternative„„„„„„„„µ±and´³rec´³lit³and„´³tupleµ´³ tuplePrefixµ´³named³pattern0´³refµ„³ NamedPattern„„´³named³pattern1´³refµ„³ NamedPattern„„„´³named³patternN´³seqof´³refµ„³ NamedPattern„„„„„„„„µ±Pattern´³refµ„³Pattern„„„„³
ModulePath´³seqof´³atom³Symbol„„³ Definitions´³dictof´³atom³Symbol„´³refµ„³
Definition„„³ NamedPattern´³orµµ±named´³refµ„³NamedSimplePattern_„„µ± anonymous´³refµ„³Pattern„„„„³ SimplePattern´³orµµ±any´³lit³any„„µ±atom´³rec´³lit³atom„´³tupleµ´³named³atomKind´³refµ„³AtomKind„„„„„„µ±embedded´³rec´³lit³embedded„´³tupleµ´³named³ interface´³refµ„³ SimplePattern„„„„„„µ±lit´³rec´³lit³lit„´³tupleµ´³named³value³any„„„„„µ±seqof´³rec´³lit³seqof„´³tupleµ´³named³pattern´³refµ„³ SimplePattern„„„„„„µ±setof´³rec´³lit³setof„´³tupleµ´³named³pattern´³refµ„³ SimplePattern„„„„„„µ±dictof´³rec´³lit³dictof„´³tupleµ´³named³key´³refµ„³ SimplePattern„„´³named³value´³refµ„³ SimplePattern„„„„„„µ±Ref´³refµ„³Ref„„„„³CompoundPattern´³orµµ±rec´³rec´³lit³rec„´³tupleµ´³named³label´³refµ„³ NamedPattern„„´³named³fields´³refµ„³ NamedPattern„„„„„„µ±tuple´³rec´³lit³tuple„´³tupleµ´³named³patterns´³seqof´³refµ„³ NamedPattern„„„„„„„µ±tuple*´³rec´³lit³tuple*„´³tupleµ´³named³fixed´³seqof´³refµ„³ NamedPattern„„„´³named³variable´³refµ„³NamedSimplePattern„„„„„„µ±dict´³rec´³lit³dict„´³tupleµ´³named³entries´³refµ„³DictionaryEntries„„„„„„„„³EmbeddedTypeName´³orµµ±Ref´³refµ„³Ref„„µ±false´³lit€„„„„³NamedAlternative´³tupleµ´³named³ variantLabel´³atom³String„„´³named³pattern´³refµ„³Pattern„„„„³DictionaryEntries´³dictof³any´³refµ„³NamedSimplePattern„„³NamedSimplePattern´³orµµ±named´³refµ„³NamedSimplePattern_„„µ± anonymous´³refµ„³ SimplePattern„„„„³NamedSimplePattern_´³rec´³lit³named„´³tupleµ´³named³name´³atom³Symbol„„´³named³pattern´³refµ„³ SimplePattern„„„„„„³ embeddedType€„„
Definition„„³ NamedPattern´³orµµ±named´³refµ„³NamedSimplePattern_„„µ± anonymous´³refµ„³Pattern„„„„³ SimplePattern´³orµµ±any´³lit³any„„µ±atom´³rec´³lit³atom„´³tupleµ´³named³atomKind´³refµ„³AtomKind„„„„„„µ±embedded´³rec´³lit³embedded„´³tupleµ´³named³ interface´³refµ„³ SimplePattern„„„„„„µ±lit´³rec´³lit³lit„´³tupleµ´³named³value³any„„„„„µ±seqof´³rec´³lit³seqof„´³tupleµ´³named³pattern´³refµ„³ SimplePattern„„„„„„µ±setof´³rec´³lit³setof„´³tupleµ´³named³pattern´³refµ„³ SimplePattern„„„„„„µ±dictof´³rec´³lit³dictof„´³tupleµ´³named³key´³refµ„³ SimplePattern„„´³named³value´³refµ„³ SimplePattern„„„„„„µ±Ref´³refµ„³Ref„„„„³CompoundPattern´³orµµ±rec´³rec´³lit³rec„´³tupleµ´³named³label´³refµ„³ NamedPattern„„´³named³fields´³refµ„³ NamedPattern„„„„„„µ±tuple´³rec´³lit³tuple„´³tupleµ´³named³patterns´³seqof´³refµ„³ NamedPattern„„„„„„„µ± tuplePrefix´³rec´³lit³ tuplePrefix„´³tupleµ´³named³fixed´³seqof´³refµ„³ NamedPattern„„„´³named³variable´³refµ„³NamedSimplePattern„„„„„„µ±dict´³rec´³lit³dict„´³tupleµ´³named³entries´³refµ„³DictionaryEntries„„„„„„„„³EmbeddedTypeName´³orµµ±Ref´³refµ„³Ref„„µ±false´³lit€„„„„³NamedAlternative´³tupleµ´³named³ variantLabel´³atom³String„„´³named³pattern´³refµ„³Pattern„„„„³DictionaryEntries´³dictof³any´³refµ„³NamedSimplePattern„„³NamedSimplePattern´³orµµ±named´³refµ„³NamedSimplePattern_„„µ± anonymous´³refµ„³ SimplePattern„„„„³NamedSimplePattern_´³rec´³lit³named„´³tupleµ´³named³name´³atom³Symbol„„´³named³pattern´³refµ„³ SimplePattern„„„„„„³ embeddedType€„„

6
schema/schema.prs
View File

@ -47,7 +47,7 @@ SimplePattern =
; =symbol, <<lit> any>, or plain non-symbol atom
/ <lit @value any>
; [p ...] ----> <seqof <ref p>>; see also tuple* below.
; [p ...] ----> <seqof <ref p>>; see also tuplePrefix below.
/ <seqof @pattern SimplePattern>
; #{p} ----> <setof <ref p>>
@ -69,9 +69,9 @@ CompoundPattern =
; [a b c] ----> <tuple [<ref a> <ref b> <ref c>]>
/ <tuple @patterns [NamedPattern ...]>
; [a b c ...] ----> <tuple* [<ref a> <ref b>] <seqof <ref c>>>
; [a b c ...] ----> <tuplePrefix [<ref a> <ref b>] <seqof <ref c>>>
; TODO: [@fixed0 NamedPattern @fixedN NamedPattern ...]
/ <tuple* @fixed [NamedPattern ...] @variable NamedSimplePattern>
/ <tuplePrefix @fixed [NamedPattern ...] @variable NamedSimplePattern>
; {a: b, c: d} ----> <dict {a: <ref b>, c: <ref d>}>
/ <dict @entries DictionaryEntries>