s-expression.orchestra

{"workspaceXML":"<xml xmlns=\"http://www.w3.org/1999/xhtml\"><block type=\"compose\" id=\"[sOtN@qXD@EtM`L!wlI^\" deletable=\"false\" x=\"210\" y=\"183\"><statement name=\"blocks\"><block type=\"comment\" id=\"^6]cPJ2H2kn2#N^|Wkw-\"><field name=\"comment\">S-Expression start</field><next><block type=\"encode\" id=\"ysIKSrrc0xu_o=.VzQgM\"><field name=\"text\">(</field><next><block type=\"any_number_of\" id=\"hOEMr(Keiqn!th1~;RQ-\"><statement name=\"blocks\"><block type=\"whitespace\" id=\"E5Im{Y)5]V;zWXiXph5t\"><field name=\"space\">TRUE</field><field name=\"tab\">TRUE</field><field name=\"linefeed\">TRUE</field></block></statement><next><block type=\"comment\" id=\"-fidRIY]=Sv8br/zeYw_\"><field name=\"comment\">S-Expression function name</field><next><block type=\"match\" id=\"0w%O@gesu),Zo*~nP3Vu\"><statement name=\"blocks\"><block type=\"exclude\" id=\"TQ*j~0uSXx-KBP3I=Q9z\"><statement name=\"blocks\"><block type=\"sigma_chars\" id=\"Eokpx)e[la}tHjbQfsJ[\"><field name=\"text\">'\":#/()[]</field><next><block type=\"sigma_range\" id=\"Xli%MYu0PY+!-FFe8ne.\"><field name=\"start\">0</field><field name=\"end\">9</field></block></next></block></statement><next><block type=\"any_number_of\" id=\"(Pg@;H0EM,TfCrk!I;_S\"><statement name=\"blocks\"><block type=\"exclude\" id=\"Ut2YrD=H;+Sq(bW!nY{:\"><statement name=\"blocks\"><block type=\"sigma_chars\" id=\"I`HQeRL4+-;/k6F0l*9{\"><field name=\"text\">)]([</field><next><block type=\"sigma_wildcard\" id=\"*)G[H#D+8Rk8g2Nhe3}8\"><field name=\"escapes\">\\s</field></block></next></block></statement></block></statement></block></next></block></statement></block></next></block></next></block></next></block></next></block></statement></block></xml>","playgroundText":"#lang racket/base\n\n'(hello world)\n(require syntax/parse/pre\n         \"../private/parse-classes.rkt\"\n         \"../private/syntax-properties.rkt\"\n         (for-label \"colon.rkt\"))\n(provide (all-defined-out))\n\n;; Data definitions\n;; ----------------\n;;\n;; A LambdaKeywords is a\n;;   (lambda-kws (Listof Keyword) (Listof Keyword))\n(struct lambda-kws (mand opt))\n\n;; interp.\n;;   - the first list contains the mandatory keywords\n;;   - the second list contains the optional keywords\n;;\n;; The TR lambda form sets this as a syntax property on lambda expansions\n;; to allow TR to check for missing keywords.\n\n(define-literal-set colon #:for-label (:))\n\n(define-splicing-syntax-class annotated-name\n  #:attributes (name ty ann-name)\n  #:description \"type-annotated identifier\"\n  #:literal-sets (colon)\n  (pattern [~seq name:id : ty]\n           #:with ann-name (type-label-property #'name #'ty))\n  (pattern name:id\n           #:attr *ty (type-label-property #'name)\n           #:when (attribute *ty)\n           #:attr ty (datum->syntax #'name (attribute *ty))\n           #:with ann-name #'name))\n\n(define-splicing-syntax-class optionally-annotated-name\n  #:attributes (name ty ann-name)\n  #:description \"optionally type-annotated identifier\"\n  #:literal-sets (colon)\n  (pattern n:annotated-name\n           #:with name #'n.name\n           #:with ty #'n.ty\n           #:with ann-name #'n.ann-name)\n  (pattern n:id\n           #:with name #'n\n           #:attr ty #f\n           #:with ann-name #'n))\n\n(define-splicing-syntax-class (param-annotated-name trans)\n  #:attributes (name ty ann-name)\n  #:description \"type-annotated identifier\"\n  #:literal-sets (colon)\n  (pattern [~seq name:id : ty]\n           #:with ann-name (type-label-property #'name (trans #'ty))))\n\n(define-syntax-class annotated-binding\n  #:attributes (name ty ann-name binding rhs)\n  (pattern (~and whole [:annotated-name rhs:expr])\n           #:with binding (syntax/loc #'whole [ann-name rhs])))\n\n(define-syntax-class optionally-annotated-binding\n  #:attributes (name ann-name binding rhs)\n  #:description \"optionally type-annotated binding\"\n  #:literal-sets (colon)\n  (pattern b:annotated-binding\n           #:with name #'b.name\n           #:with ann-name #'b.ann-name\n           #:with binding #'b.binding\n           #:with rhs #'b.rhs)\n  (pattern (~and whole [n:id rhs:expr])\n           #:with name #'n\n           #:with ann-name #'n\n           #:with binding #'whole))\n\n(define-syntax-class annotated-values-binding\n  #:attributes ((name 1) (ty 1) (ann-name 1) binding rhs)\n  (pattern (~and whole [(~describe \"sequence of type-annotated identifiers\" ([:annotated-name] ...)) rhs:expr])\n           #:with binding (syntax/loc #'whole [(ann-name ...) rhs])))\n\n(define-syntax-class optionally-annotated-values-binding\n  #:attributes ((name 1) (ann-name 1) binding rhs)\n  (pattern b:annotated-values-binding\n           #:with (name ...) #'(b.name ...)\n           #:with (ann-name ...) #'(b.ann-name ...)\n           #:with binding #'b.binding\n           #:with rhs #'b.rhs)\n  (pattern (~and whole [(~describe \"sequence of optionally type-annotated identifiers\" (n:optionally-annotated-formal ...)) rhs:expr])\n           #:with (name ...) #'(n.name ...)\n           #:with (ann-name ...) #'(n.ann-name ...)\n           #:with binding #'whole))\n\n(define-splicing-syntax-class annotated-star-rest\n  #:attributes (name ann-name ty formal-ty)\n  #:literal-sets (colon)\n  (pattern (~seq name:id : ty s:star)\n           #:with formal-ty #'(ty s)\n           #:with ann-name (type-label-property #'name #'ty)))\n\n(define-splicing-syntax-class annotated-dots-rest\n  #:attributes (name ann-name bound ty formal-ty)\n  #:literal-sets (colon)\n  (pattern (~seq name:id : ty bnd:ddd/bound)\n           #:with formal-ty #'(ty . bnd)\n           #:attr bound (attribute bnd.bound)\n           #:with ann-name (type-dotted-property\n                             (type-label-property #'name #'ty)\n                             (attribute bnd.bound))))\n\n(define-syntax-class annotated-formal\n  #:description \"annotated variable of the form [x : T]\"\n  #:opaque\n  #:attributes (name ty ann-name)\n  (pattern [:annotated-name]))\n\n(define-syntax-class optionally-annotated-formal\n  #:description \"optionally annotated variable of the form [x : T] or just x\"\n  #:opaque\n  #:attributes (name ty ann-name)\n  (pattern f:annotated-formal\n           #:with name #'f.name\n           #:attr ty #'f.ty\n           #:with ann-name #'f.ann-name)\n  (pattern f:id\n           #:with name #'f\n           #:attr ty #f\n           #:with ann-name #'f))\n\n(define-syntax-class annotated-formals\n  #:attributes (ann-formals (arg-ty 1))\n  #:literal-sets (colon)\n  (pattern (n:annotated-formal ...)\n           #:with ann-formals #'(n.ann-name ...)\n           #:with (arg-ty ...) #'(n.ty ...))\n  (pattern (n:annotated-formal ... (~describe \"dotted or starred type\"\n                                              (~or rest:annotated-star-rest rest:annotated-dots-rest)))\n           #:with ann-formals #'(n.ann-name ... . rest.ann-name)\n           #:with (arg-ty ...) #'(n.ty ... . rest.formal-ty)))\n\n(define-syntax-class opt-lambda-annotated-formal\n  #:description \"annotated variable, potentially with a default value\"\n  #:opaque\n  #:attributes (name ty ann-name)\n  (pattern [:annotated-name])\n  (pattern [n:annotated-name val]\n           #:with name #'n.name\n           #:with ty #'n.name\n           #:with ann-name #'(n.ann-name val)))\n\n(define-syntax-class opt-lambda-annotated-formals\n  #:attributes (ann-formals (arg-ty 1))\n  #:literal-sets (colon)\n  (pattern (n:opt-lambda-annotated-formal ...)\n           #:with ann-formals #'(n.ann-name ...)\n           #:with (arg-ty ...) #'(n.ty ...))\n  (pattern (n:opt-lambda-annotated-formal ...\n            (~describe \"dotted or starred type\"\n                       (~or rest:annotated-star-rest rest:annotated-dots-rest)))\n           #:with ann-formals #'(n.ann-name ... . rest.ann-name)\n           #:with (arg-ty ...) #'(n.ty ... . rest.formal-ty)))\n\n(define-splicing-syntax-class standalone-annotation\n  #:literal-sets (colon)\n  (pattern (~seq : t)\n           #:with ty #'t))\n(define-splicing-syntax-class optional-standalone-annotation\n  (pattern (~optional a:standalone-annotation)\n           #:attr ty (if (attribute a) #'a.ty #f)))\n\n(define-syntax-class type-variables\n  #:attributes ((vars 1))\n  #:description \"a sequence of type variables\"\n  (pattern (vars:id ...)\n           #:fail-when (check-duplicate-identifier (syntax->list #'(vars ...)))\n           \"duplicate type variable declaration\"))\n\n(define-splicing-syntax-class lambda-type-vars\n  #:description \"optional type parameters\"\n  #:attributes (type-vars)\n  (pattern (~seq (~or #:forall #:∀) (var:id ...))\n           #:attr type-vars #'(var ...)))\n\n(define-splicing-syntax-class maybe-lambda-type-vars\n  #:description \"optional type parameters\"\n  #:attributes (type-vars)\n  (pattern :lambda-type-vars)\n  (pattern (~seq) #:attr type-vars #f))\n\n(define-splicing-syntax-class kw-formal\n  #:attributes (form id default type kw)\n  #:literal-sets (colon)\n  (pattern (~seq kw:keyword id:id)\n           #:with form #'(kw id)\n           #:attr default #f\n           #:attr type #f)\n  (pattern (~seq kw:keyword [id:id default:expr])\n           #:with form #'(kw [id default])\n           #:attr type #f)\n  (pattern (~seq kw:keyword [id:id : type:expr])\n           #:with form #`(kw #,(type-label-property #'id #'type))\n           #:attr default #f)\n  (pattern (~seq kw:keyword [id:id : type:expr default:expr])\n           #:with form #`(kw [#,(type-label-property #'id #'type) default])))\n\n(define-splicing-syntax-class mand-formal\n  #:description \"lambda argument\"\n  #:attributes (form id default type kw)\n  #:literal-sets (colon)\n  (pattern id:id\n           #:with form #'(id)\n           #:attr default #f\n           #:attr type #f\n           #:attr kw #f)\n  (pattern [id:id : type:expr]\n           #:with form #`(#,(type-label-property #'id #'type))\n           #:attr default #f\n           #:attr kw #f)\n  (pattern :kw-formal))\n\n(define-splicing-syntax-class opt-formal\n  #:description \"optional lambda argument\"\n  #:attributes (form id default type kw)\n  #:literal-sets (colon)\n  (pattern [id:id default:expr]\n           #:with form #'([id default])\n           #:attr type #f\n           #:attr kw #f)\n  (pattern [id:id : type:expr default:expr]\n           #:with form #`([#,(type-label-property #'id #'type) default])\n           #:attr kw #f)\n  (pattern :kw-formal))\n\n(define-syntax-class rest-arg\n  #:description \"rest argument\"\n  #:attributes (form)\n  #:literal-sets (colon)\n  ;; specifying opaque here helps produce a better error\n  ;; message for optional argumenents, but produces worse\n  ;; error messages for rest arguments.\n  #:opaque\n  (pattern rest:id #:attr form #'rest)\n  (pattern (rest:id : type:expr :star)\n           #:attr form (type-label-property #'rest #'type))\n  (pattern (rest:id : type:expr bnd:ddd/bound)\n           #:attr bound (attribute bnd.bound)\n           #:attr form (type-dotted-property\n                        (type-label-property #'rest #'type)\n                        (attribute bound))))\n\n(define-syntax-class lambda-formals\n  #:attributes (opt-property kw-property erased)\n  (pattern (~or (mand:mand-formal ... opt:opt-formal ... . rest:rest-arg)\n                (~and (mand:mand-formal ... opt:opt-formal ...)\n                      (~bind [rest.form #'()])))\n           #:attr kw-property\n           ;; separate raw keywords into mandatory and optional and\n           ;; put them in a struct for later use by tc-expr\n           (let ([kws (append (attribute mand.kw)\n                              (attribute opt.kw))]\n                 [opt?s (append (attribute mand.default)\n                                (attribute opt.default))])\n             (define-values (mand-kws opt-kws)\n               (for/fold ([mand-kws '()]\n                          [opt-kws '()])\n                         ([kw (in-list kws)]\n                          [opt? (in-list opt?s)]\n                          #:when kw)\n                 (if opt?\n                     (values mand-kws (cons (syntax-e kw) opt-kws))\n                     (values (cons (syntax-e kw) mand-kws) opt-kws))))\n             (and (or (not (null? mand-kws))\n                      (not (null? opt-kws)))\n                  (lambda-kws mand-kws opt-kws)))\n           #:attr opt-property\n           (list (length (attribute mand)) (length (attribute opt)))\n           #:attr erased\n           (with-syntax ([((mand-form ...) ...) #'(mand.form ...)]\n                         [((opt-form ...) ...) #'(opt.form ...)])\n             (syntax (mand-form ... ... opt-form ... ... . rest.form)))))\n\n(define-syntax-class curried-formals\n  #:attributes (erased fun-name)\n  (pattern fun:id\n           #:with fun-name #'fun\n           #:with erased #'fun)\n  (pattern (fun:curried-formals . formals:lambda-formals)\n           #:with fun-name #'fun.fun-name\n           #:with erased #`(fun.erased . #,(attribute formals.erased))))\n\n(define-splicing-syntax-class return-ann\n  #:description \"return type annotation\"\n  #:literal-sets (colon)\n  (pattern (~seq : type:expr)))\n(pattern (~seq) #:attr type #f)\n"}