From fdb43f629243bda7d8e08ce92741b4c8ec7f946e Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Fri, 25 Jun 2021 09:45:07 +0200 Subject: [PATCH] Constrain names/identifiers in schemas to be lowest-common-denominator. --- .../javascript/packages/schema/src/checker.ts | 17 +++++- .../schema/src/compiler/genconverter.ts | 2 +- .../packages/schema/src/compiler/gentype.ts | 2 +- .../schema/src/compiler/genunconverter.ts | 2 +- .../packages/schema/src/gen/schema.ts | 14 ++--- .../javascript/packages/schema/src/meta.ts | 11 +++- .../javascript/packages/schema/src/reader.ts | 31 +++++++---- .../preserves/preserves-schema/checker.rkt | 24 ++++++-- .../preserves/preserves-schema/compiler.rkt | 2 +- .../preserves/preserves-schema/gen/schema.rkt | 28 +++++----- .../preserves/preserves-schema/parser.rkt | 2 +- .../preserves/preserves-schema/reader.rkt | 55 +++++++++++++------ .../preserves/preserves-schema/schema.prs | 6 +- .../preserves/preserves-schema/type.rkt | 11 +--- .../preserves/preserves-schema/unparser.rkt | 2 +- preserves-schema.md | 42 ++++++++------ schema/schema.bin | 4 +- schema/schema.prs | 6 +- 18 files changed, 164 insertions(+), 97 deletions(-) diff --git a/implementations/javascript/packages/schema/src/checker.ts b/implementations/javascript/packages/schema/src/checker.ts index c7e7dfd..8c835aa 100644 --- a/implementations/javascript/packages/schema/src/checker.ts +++ b/implementations/javascript/packages/schema/src/checker.ts @@ -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( diff --git a/implementations/javascript/packages/schema/src/compiler/genconverter.ts b/implementations/javascript/packages/schema/src/compiler/genconverter.ts index 8341eb5..4cd60b0 100644 --- a/implementations/javascript/packages/schema/src/compiler/genconverter.ts +++ b/implementations/javascript/packages/schema/src/compiler/genconverter.ts @@ -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); diff --git a/implementations/javascript/packages/schema/src/compiler/gentype.ts b/implementations/javascript/packages/schema/src/compiler/gentype.ts index ca49105..cb8ddfc 100644 --- a/implementations/javascript/packages/schema/src/compiler/gentype.ts +++ b/implementations/javascript/packages/schema/src/compiler/gentype.ts @@ -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; diff --git a/implementations/javascript/packages/schema/src/compiler/genunconverter.ts b/implementations/javascript/packages/schema/src/compiler/genunconverter.ts index 6bc074f..1524345 100644 --- a/implementations/javascript/packages/schema/src/compiler/genunconverter.ts +++ b/implementations/javascript/packages/schema/src/compiler/genunconverter.ts @@ -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) { diff --git a/implementations/javascript/packages/schema/src/gen/schema.ts b/implementations/javascript/packages/schema/src/gen/schema.ts index 2513129..d05352b 100644 --- a/implementations/javascript/packages/schema/src/gen/schema.ts +++ b/implementations/javascript/packages/schema/src/gen/schema.ts @@ -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} | { - "_variant": "tuple*", + "_variant": "tuplePrefix", "fixed": Array, "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): CompoundPattern {return {"_variant": "tuple", "patterns": patterns};}; - export function tuple$STAR$({fixed, variable}: {fixed: Array, variable: NamedSimplePattern}): CompoundPattern {return {"_variant": "tuple*", "fixed": fixed, "variable": variable};}; + export function tuplePrefix({fixed, variable}: {fixed: Array, 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) | 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"]) diff --git a/implementations/javascript/packages/schema/src/meta.ts b/implementations/javascript/packages/schema/src/meta.ts index 87f4964..250b31c 100644 --- a/implementations/javascript/packages/schema/src/meta.ts +++ b/implementations/javascript/packages/schema/src/meta.ts @@ -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 { diff --git a/implementations/javascript/packages/schema/src/reader.ts b/implementations/javascript/packages/schema/src/reader.ts index a5d0875..7f47ba4 100644 --- a/implementations/javascript/packages/schema/src/reader.ts +++ b/implementations/javascript/packages/schema/src/reader.ts @@ -93,7 +93,7 @@ export function parseSchema(toplevelTokens: Array, 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) 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) }); } 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): 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, M._embedded>(item)) { const label = item.label; @@ -294,7 +302,7 @@ function parsePattern(name: symbol, body0: Array): 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): 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(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; } diff --git a/implementations/racket/preserves/preserves-schema/checker.rkt b/implementations/racket/preserves/preserves-schema/checker.rkt index e14a0ae..dd5c977 100644 --- a/implementations/racket/preserves/preserves-schema/checker.rkt +++ b/implementations/racket/preserves/preserves-schema/checker.rkt @@ -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)))] diff --git a/implementations/racket/preserves/preserves-schema/compiler.rkt b/implementations/racket/preserves/preserves-schema/compiler.rkt index f017941..75ea3fb 100644 --- a/implementations/racket/preserves/preserves-schema/compiler.rkt +++ b/implementations/racket/preserves/preserves-schema/compiler.rkt @@ -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)) diff --git a/implementations/racket/preserves/preserves-schema/gen/schema.rkt b/implementations/racket/preserves/preserves-schema/gen/schema.rkt index 920fe67..17dafe8 100644 --- a/implementations/racket/preserves/preserves-schema/gen/schema.rkt +++ b/implementations/racket/preserves/preserves-schema/gen/schema.rkt @@ -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) diff --git a/implementations/racket/preserves/preserves-schema/parser.rkt b/implementations/racket/preserves/preserves-schema/parser.rkt index a2426a4..8b30bf8 100644 --- a/implementations/racket/preserves/preserves-schema/parser.rkt +++ b/implementations/racket/preserves/preserves-schema/parser.rkt @@ -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 '_) diff --git a/implementations/racket/preserves/preserves-schema/reader.rkt b/implementations/racket/preserves/preserves-schema/reader.rkt index e74cf21..9118516 100644 --- a/implementations/racket/preserves/preserves-schema/reader.rkt +++ b/implementations/racket/preserves/preserves-schema/reader.rkt @@ -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 diff --git a/implementations/racket/preserves/preserves-schema/schema.prs b/implementations/racket/preserves/preserves-schema/schema.prs index 6602008..2cf2df8 100644 --- a/implementations/racket/preserves/preserves-schema/schema.prs +++ b/implementations/racket/preserves/preserves-schema/schema.prs @@ -47,7 +47,7 @@ SimplePattern = ; =symbol, < any>, or plain non-symbol atom / - ; [p ...] ----> >; see also tuple* below. + ; [p ...] ----> >; see also tuplePrefix below. / ; #{p} ----> > @@ -69,9 +69,9 @@ CompoundPattern = ; [a b c] ----> ]> / - ; [a b c ...] ----> ] >> + ; [a b c ...] ----> ] >> ; TODO: [@fixed0 NamedPattern @fixedN NamedPattern ...] - / + / ; {a: b, c: d} ----> , c: }> / diff --git a/implementations/racket/preserves/preserves-schema/type.rkt b/implementations/racket/preserves/preserves-schema/type.rkt index ea47887..b60bb16 100644 --- a/implementations/racket/preserves/preserves-schema/type.rkt +++ b/implementations/racket/preserves/preserves-schema/type.rkt @@ -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)) diff --git a/implementations/racket/preserves/preserves-schema/unparser.rkt b/implementations/racket/preserves/preserves-schema/unparser.rkt index 6f01207..920c089 100644 --- a/implementations/racket/preserves/preserves-schema/unparser.rkt +++ b/implementations/racket/preserves/preserves-schema/unparser.rkt @@ -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)) diff --git a/preserves-schema.md b/preserves-schema.md index 13792af..96ba373 100644 --- a/preserves-schema.md +++ b/preserves-schema.md @@ -4,7 +4,7 @@ title: "Preserves Schema" --- Tony Garnock-Jones -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, < any>, or plain non-symbol atom / - ; [p ...] ----> >; see also tuple* below. + ; [p ...] ----> >; see also tuplePrefix below. / ; #{p} ----> > @@ -420,8 +428,8 @@ Compound patterns involve optionally-named subpatterns: ; [a b c] ----> ]> / - ; [a b c ...] ----> ] >> - / + ; [a b c ...] ----> ] >> + / ; {a: b, c: d} ----> , c: }> / @@ -462,7 +470,7 @@ metaschema. > ]>>], ["tuple", >>]>>], - ["tuple*", >>, > ]>>], @@ -484,11 +492,11 @@ metaschema. ]>>, Definition: >, > ] >>>]>>], - ["and", >, > ] >>>]>>], @@ -621,7 +629,7 @@ definitions for the metaschema. {"_variant": "rec", "label": NamedPattern, "fields": NamedPattern} | {"_variant": "tuple", "patterns": Array} | { - "_variant": "tuple*", + "_variant": "tuplePrefix", "fixed": Array, "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) diff --git a/schema/schema.bin b/schema/schema.bin index b05f0a0..79d4165 100644 --- a/schema/schema.bin +++ b/schema/schema.bin @@ -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€„„ \ No newline at end of file +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€„„ \ No newline at end of file diff --git a/schema/schema.prs b/schema/schema.prs index 6602008..2cf2df8 100644 --- a/schema/schema.prs +++ b/schema/schema.prs @@ -47,7 +47,7 @@ SimplePattern = ; =symbol, < any>, or plain non-symbol atom / - ; [p ...] ----> >; see also tuple* below. + ; [p ...] ----> >; see also tuplePrefix below. / ; #{p} ----> > @@ -69,9 +69,9 @@ CompoundPattern = ; [a b c] ----> ]> / - ; [a b c ...] ----> ] >> + ; [a b c ...] ----> ] >> ; TODO: [@fixed0 NamedPattern @fixedN NamedPattern ...] - / + / ; {a: b, c: d} ----> , c: }> /