<commit_before>;; Like elaborate.scm for the new scheme

(define (parse-exp e)
  (case
    ((match e
       ((operator @_) (look-up-macro operator))
       (_ #no))
     => (given (expand) (parse-exp (expand e))))
    (else
     (match e
       ((: _ symbol?)
        {variable e})
       (('quote datum)
        {constant datum})
       ((: _ self-evaluating?)
        {constant e})
       (('let p e1)
        {let (parse-pat p) (parse-exp e1)})
       (('make '_ @clauses)
        (parse-make #no clauses))
       (('make (: name symbol?) @clauses)
        {let name (parse-make name clauses)})
       (('make @clauses)
        (parse-make #no clauses))
       (('do e1)
        (parse-exp e1))
       (('do e1 @es)
        {do (parse-exp e1) (parse-exp `(do ,@es))})
       ((addressee (: cue cue?) @operands)
        {call (parse-exp addressee)
              {term cue {list (each parse-exp operands)}}})
       ((addressee @operands)
        {call (parse-exp addressee)
              {list (each parse-exp operands)}})
       ((: _ term?)
        {term e.tag {list (each parse-exp e.arguments)}})
       ))))

;; what's the syntax for a macro in pattern context?
(define (parse-pat p)
  (match p
    ('_
     {any-pat})
    ((: _ symbol?)
     {variable-pat p})
    ((: _ self-evaluating?)
     {constant-pat p})
    (('quote datum)
     {constant-pat datum})
    ((@ps)
     (parse-list-pat ps))
    ((': p1 e p2)
     {and-pat (parse-pat p1)
              {view-pat (parse-exp e1) (parse-pat p2)}})
    ((': p1 e)
     {and-pat (parse-pat p1)
              {view-pat (parse-exp e1) {constant-pat #yes}}})
    ))

(define (parse-list-pat ps)
  (begin parsing ((results '()) (ps ps))
    (match ps
      (()
       (list-pat<- (reverse results)))
      (((: p at-variable?))
       {prefix-pat (reverse results) (parse-pat p.argument)})
      (((: _ at-variable?) @_)
       (error "@pattern not at end of list" ps))
      ((p rest)
       (parsing (cons (parse-pat p) results) rest)))))

(define (list-pat<- ps)
  {and-pat {count-pat ps.count}
           {prefix-pat ps {any-pat}}})

(define (self-evaluating? x)
  (or (boolean? x)
      (number? x)
      (char? x)
      (string? x)))

(define (look-up-macro key)
  (match key
    ('hide   (make
              XXX))
    ('include (make             ;temporary
               ((_ (: filename string?))
                `(do ,@(snarf filename)))))
    ('define (make
              ((_ ((: v symbol?) @params) @body)
               `(make ,v (,params ,@body)))
              ((_ (call-form @params) @body)
               `(define ,call-form (given ,params ,@body)))))
    ('given  (make
              ((_ vars @body)
               `(make (,vars ,@body)))))
    ('with   (make
              ((_ bindings @body)
               (let (ps es) (parse-bindings bindings))
               `((given ,ps ,@body) ,@es))))<commit_msg>hide macro<commit_after>;; Like elaborate.scm for the new scheme

(define (parse-exp e)
  (case
    ((match e
       ((operator @_) (look-up-macro operator))
       (_ #no))
     => (given (expand) (parse-exp (expand e))))
    (else
     (match e
       ((: _ symbol?)
        {variable e})
       (('quote datum)
        {constant datum})
       ((: _ self-evaluating?)
        {constant e})
       (('let p e1)
        {let (parse-pat p) (parse-exp e1)})
       (('make '_ @clauses)
        (parse-make #no clauses))
       (('make (: name symbol?) @clauses)
        {let name (parse-make name clauses)})
       (('make @clauses)
        (parse-make #no clauses))
       (('do e1)
        (parse-exp e1))
       (('do e1 @es)
        {do (parse-exp e1) (parse-exp `(do ,@es))})
       ((addressee (: cue cue?) @operands)
        {call (parse-exp addressee)
              {term cue {list (each parse-exp operands)}}})
       ((addressee @operands)
        {call (parse-exp addressee)
              {list (each parse-exp operands)}})
       ((: _ term?)
        {term e.tag {list (each parse-exp e.arguments)}})
       ))))

;; what's the syntax for a macro in pattern context?
(define (parse-pat p)
  (match p
    ('_
     {any-pat})
    ((: _ symbol?)
     {variable-pat p})
    ((: _ self-evaluating?)
     {constant-pat p})
    (('quote datum)
     {constant-pat datum})
    ((@ps)
     (parse-list-pat ps))
    ((': p1 e p2)
     {and-pat (parse-pat p1)
              {view-pat (parse-exp e1) (parse-pat p2)}})
    ((': p1 e)
     {and-pat (parse-pat p1)
              {view-pat (parse-exp e1) {constant-pat #yes}}})
    ))

(define (parse-list-pat ps)
  (begin parsing ((results '()) (ps ps))
    (match ps
      (()
       (list-pat<- (reverse results)))
      (((: p at-variable?))
       {prefix-pat (reverse results) (parse-pat p.argument)})
      (((: _ at-variable?) @_)
       (error "@pattern not at end of list" ps))
      ((p rest)
       (parsing (cons (parse-pat p) results) rest)))))

(define (list-pat<- ps)
  {and-pat {count-pat ps.count}
           {prefix-pat ps {any-pat}}})

(define (self-evaluating? x)
  (or (boolean? x)
      (number? x)
      (char? x)
      (string? x)))

(define (look-up-macro key)
  (match key
    ('hide   (make
              ((_ @es)
               `((given () ,@es)))))
    ('include (make             ;temporary
               ((_ (: filename string?))
                `(do ,@(snarf filename)))))
    ('define (make
              ((_ ((: v symbol?) @params) @body)
               `(make ,v (,params ,@body)))
              ((_ (call-form @params) @body)
               `(define ,call-form (given ,params ,@body)))))
    ('given  (make
              ((_ vars @body)
               `(make (,vars ,@body)))))
    ('with   (make
              ((_ bindings @body)
               (let (ps es) (parse-bindings bindings))
               `((given ,ps ,@body) ,@es))))
{'fraction_non_alphanumeric': 0.18455158113011924, 'fraction_numerical': 0.004838430965958182, 'mean_word_length': 1.811073336571151, 'pattern_counts': {'":': 0, '<': 7, '<?xml version=': 0, '>': 5, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4510785', 'n_tokens_mistral': 2009, 'n_tokens_neox': 1945, 'n_words': 532}