<commit_before>;; -*- mode: scheme -*-

;; ``72. An adequate bootstrap is a contradiction in terms.''

;; Rename ur-define
(vm-def _define vm-def)

;; Rename bindings that will be used as provided by VM
(_define array-to-list vm-array-to-list)
(_define begin vm-begin)
(_define cons vm-cons)
(_define cons? vm-cons?)
(_define dnew vm-dnew)
(_define dref vm-dref)
(_define error vm-error)
(_define eval vm-eval)
(_define if vm-if)
(_define js-getter vm-js-getter)
(_define js-global vm-js-global)
(_define js-invoker vm-js-invoker)
(_define list* vm-list*)
(_define list-to-array vm-list-to-array)
(_define make-environment vm-make-environment)
(_define new vm-js-new)
(_define nil? vm-nil?)
(_define reverse-list vm-reverse-list)
(_define setter vm-setter)
(_define symbol-name vm-symbol-name)
(_define symbol? vm-symbol?)
(_define throw vm-throw)
(_define unwrap vm-unwrap)
(_define wrap vm-wrap)

;; Important utilities
(_define quote (vm-vau (x) #ignore x))
(_define list (wrap (vm-vau elts #ignore elts)))
(_define the-environment (vm-vau () e e))

;; Macro and vau
(_define make-macro-expander
  (wrap
    (vm-vau (expander) #ignore
      (vm-vau operands env
        (eval (eval (cons expander operands) (make-environment)) env)))))

(_define _vau
  (make-macro-expander
    (vm-vau (params env-param . body) #ignore
      (list vm-vau params env-param (list* begin body)))))

(_define macro
  (make-macro-expander
    (_vau (params . body) #ignore
      (list make-macro-expander (list* _vau params #ignore body)))))

;; Ur-lambda
(_define _lambda
  (macro (params . body)
    (list wrap (list* _vau params #ignore body))))

;; Wrap incomplete VM forms
(_define loop
  (macro body
    (list vm-loop (list* begin body))))

(_define catch
  (_vau (protected handler) e
    (eval (list vm-catch protected (eval handler e)) e)))

(_define push-prompt
  (_vau (prompt . body) e
    (eval (list vm-push-prompt (eval prompt e) (list* begin body)) e)))

(_define take-subcont
  (macro (prompt k . body)
    (list vm-take-subcont prompt (list* _lambda (list k) body))))

(_define push-subcont
  (macro (k . body)
    (list vm-push-subcont k (list* _lambda () body))))

;; List utilities
(_define compose (_lambda (f g) (_lambda (arg) (f (g arg)))))

(_define car (_lambda ((x . #ignore)) x))
(_define cdr (_lambda ((#ignore . x)) x))
(_define caar (compose car car))
(_define cadr (compose car cdr))
(_define cdar (compose cdr car))
(_define cddr (compose cdr cdr))

;; Important macros and functions
(_define define-macro
  (macro ((name . params) . body)
    (list _define name (list* macro params body))))

(_define map-list
  (_lambda (f lst)
    (if (nil? lst)
        ()
        (cons (f (car lst)) (map-list f (cdr lst))))))

(_define fold-list
  (_lambda (f init lst)
    (if (nil? lst)
        init
        (fold-list f (f init (car lst)) (cdr lst)))))

(define-macro (let bindings . body)
  (cons
   (list* _lambda (map-list car bindings) body)
   (map-list cadr bindings)))

(define-macro (let* bindings . body)
  (if (nil? bindings)
    (list* let () body)
    (list let (list (car bindings)) (list* let* (cdr bindings) body))))

(_define lambda
  (_vau (params . body) e
    (_define typed-params->names-and-checks
      (_lambda (ps)
        (if (cons? ps)
            (let* (((p . rest-ps) ps)
                   ((names . checks) (typed-params->names-and-checks rest-ps)))
              (if (cons? p)
                  (let* (((name type) p)
                         (check (list the type name)))
                    (cons (cons name names) (cons check checks)))
                  (cons (cons p names) checks)))
            (cons ps ()))))
    (let (((untyped-names . type-checks) (typed-params->names-and-checks params)))
      (eval (list* _lambda untyped-names (list* begin type-checks) body) e))))

(define-macro (define lhs . rhs)
  (if (cons? lhs)
    (list _define (car lhs) (list* lambda (cdr lhs) rhs))
    (list _define lhs (car rhs))))

(define (apply appv arg . opt)
  (if (instanceof appv $Function)
      (~apply appv #null (list-to-array arg))
      (eval (cons (unwrap appv) arg)
            (if (nil? opt)
                (make-environment)
                (car opt)))))

;; Simple control
(define cond
  (_vau clauses env
    (if (nil? clauses)
        #undefined
        (let ((((test . body) . clauses) clauses))
          (if (eval test env)
              (apply (wrap begin) body env)
              (apply (wrap cond) clauses env))))))

(define else #t)

(define and
  (_vau x e
    (cond ((nil? x) #t)
          ((nil? (cdr x)) (eval (car x) e))
          ((eval (car x) e) (apply (wrap and) (cdr x) e))
          (else #f))))

(define or
  (_vau x e
    (cond ((nil? x) #f)
          ((nil? (cdr x)) (eval (car x) e))
          ((eval (car x) e) #t)
          (else (apply (wrap or) (cdr x) e)))))

(define (call-with-escape fun)
  (let ((fresh (list #null)))
    (catch (fun (_lambda opt-arg (throw (list fresh opt-arg))))
      (_lambda (exc)
        (if (and (cons? exc) (=== fresh (car exc)))
            (let ((opt-arg (cadr exc)))
              (if (cons? opt-arg) (car opt-arg) #undefined))
            (throw exc))))))

(define-macro (label name . body)
  (list call-with-escape (list* _lambda (list name) body)))

(define (call-while test-fun body-fun)
  (label return
    (loop
      (if (test-fun)
        (body-fun)<commit_msg>Reformat and and or<commit_after>;; -*- mode: scheme -*-

;; ``72. An adequate bootstrap is a contradiction in terms.''

;; Rename ur-define
(vm-def _define vm-def)

;; Rename bindings that will be used as provided by VM
(_define array-to-list vm-array-to-list)
(_define begin vm-begin)
(_define cons vm-cons)
(_define cons? vm-cons?)
(_define dnew vm-dnew)
(_define dref vm-dref)
(_define error vm-error)
(_define eval vm-eval)
(_define if vm-if)
(_define js-getter vm-js-getter)
(_define js-global vm-js-global)
(_define js-invoker vm-js-invoker)
(_define list* vm-list*)
(_define list-to-array vm-list-to-array)
(_define make-environment vm-make-environment)
(_define new vm-js-new)
(_define nil? vm-nil?)
(_define reverse-list vm-reverse-list)
(_define setter vm-setter)
(_define symbol-name vm-symbol-name)
(_define symbol? vm-symbol?)
(_define throw vm-throw)
(_define unwrap vm-unwrap)
(_define wrap vm-wrap)

;; Important utilities
(_define quote (vm-vau (x) #ignore x))
(_define list (wrap (vm-vau elts #ignore elts)))
(_define the-environment (vm-vau () e e))

;; Macro and vau
(_define make-macro-expander
  (wrap
    (vm-vau (expander) #ignore
      (vm-vau operands env
        (eval (eval (cons expander operands) (make-environment)) env)))))

(_define _vau
  (make-macro-expander
    (vm-vau (params env-param . body) #ignore
      (list vm-vau params env-param (list* begin body)))))

(_define macro
  (make-macro-expander
    (_vau (params . body) #ignore
      (list make-macro-expander (list* _vau params #ignore body)))))

;; Ur-lambda
(_define _lambda
  (macro (params . body)
    (list wrap (list* _vau params #ignore body))))

;; Wrap incomplete VM forms
(_define loop
  (macro body
    (list vm-loop (list* begin body))))

(_define catch
  (_vau (protected handler) e
    (eval (list vm-catch protected (eval handler e)) e)))

(_define push-prompt
  (_vau (prompt . body) e
    (eval (list vm-push-prompt (eval prompt e) (list* begin body)) e)))

(_define take-subcont
  (macro (prompt k . body)
    (list vm-take-subcont prompt (list* _lambda (list k) body))))

(_define push-subcont
  (macro (k . body)
    (list vm-push-subcont k (list* _lambda () body))))

;; List utilities
(_define compose (_lambda (f g) (_lambda (arg) (f (g arg)))))

(_define car (_lambda ((x . #ignore)) x))
(_define cdr (_lambda ((#ignore . x)) x))
(_define caar (compose car car))
(_define cadr (compose car cdr))
(_define cdar (compose cdr car))
(_define cddr (compose cdr cdr))

;; Important macros and functions
(_define define-macro
  (macro ((name . params) . body)
    (list _define name (list* macro params body))))

(_define map-list
  (_lambda (f lst)
    (if (nil? lst)
        ()
        (cons (f (car lst)) (map-list f (cdr lst))))))

(_define fold-list
  (_lambda (f init lst)
    (if (nil? lst)
        init
        (fold-list f (f init (car lst)) (cdr lst)))))

(define-macro (let bindings . body)
  (cons
   (list* _lambda (map-list car bindings) body)
   (map-list cadr bindings)))

(define-macro (let* bindings . body)
  (if (nil? bindings)
    (list* let () body)
    (list let (list (car bindings)) (list* let* (cdr bindings) body))))

(_define lambda
  (_vau (params . body) e
    (_define typed-params->names-and-checks
      (_lambda (ps)
        (if (cons? ps)
            (let* (((p . rest-ps) ps)
                   ((names . checks) (typed-params->names-and-checks rest-ps)))
              (if (cons? p)
                  (let* (((name type) p)
                         (check (list the type name)))
                    (cons (cons name names) (cons check checks)))
                  (cons (cons p names) checks)))
            (cons ps ()))))
    (let (((untyped-names . type-checks) (typed-params->names-and-checks params)))
      (eval (list* _lambda untyped-names (list* begin type-checks) body) e))))

(define-macro (define lhs . rhs)
  (if (cons? lhs)
    (list _define (car lhs) (list* lambda (cdr lhs) rhs))
    (list _define lhs (car rhs))))

(define (apply appv arg . opt)
  (if (instanceof appv $Function)
      (~apply appv #null (list-to-array arg))
      (eval (cons (unwrap appv) arg)
            (if (nil? opt)
                (make-environment)
                (car opt)))))

;; Simple control
(define cond
  (_vau clauses env
    (if (nil? clauses)
        #undefined
        (let ((((test . body) . clauses) clauses))
          (if (eval test env)
              (apply (wrap begin) body env)
              (apply (wrap cond) clauses env))))))

(define else #t)

(define and
  (_vau x e
    (cond ((nil? x)         #t)
          ((nil? (cdr x))   (eval (car x) e))
          ((eval (car x) e) (apply (wrap and) (cdr x) e))
          (else             #f))))

(define or
  (_vau x e
    (cond ((nil? x)         #f)
          ((nil? (cdr x))   (eval (car x) e))
          ((eval (car x) e) #t)
          (else             (apply (wrap or) (cdr x) e)))))

(define (call-with-escape fun)
  (let ((fresh (list #null)))
    (catch (fun (_lambda opt-arg (throw (list fresh opt-arg))))
      (_lambda (exc)
        (if (and (cons? exc) (=== fresh (car exc)))
            (let ((opt-arg (cadr exc)))
              (if (cons? opt-arg) (car opt-arg) #undefined))
            (throw exc))))))

(define-macro (label name . body)
  (list call-with-escape (list* _lambda (list name) body)))

(define (call-while test-fun body-fun)
  (label return
    (loop
      (if (test-fun)
        (body-fun)
{'fraction_non_alphanumeric': 0.15827471306923363, 'fraction_numerical': 0.00037023324694557573, 'mean_word_length': 2.675170068027211, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 9, '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': '1802189', 'n_tokens_mistral': 3787, 'n_tokens_neox': 3679, 'n_words': 1262}