StarSugar

(declaim (inline mvfold mvfold!))
#-sbcl
(defun mvfold (f initf &rest lsts)
  (declare (dynamic-extent lsts))
  (declare (optimize (speed 3)))
  (when (or (null lsts) (some #'null lsts))
    (return-from mvfold (funcall initf)))
  (let ((acc (multiple-value-list (funcall initf))))
    (do ()
      ((progn

StarSugar

(cl-defmacro sortf (test &rest forms)
  (cl-labels ((collect-places (f rest-places getters setters)
                (cond ((null rest-places)
                       (funcall f (nreverse getters) (nreverse setters)))
                      (t (gv-letplace (getter setter) (car rest-places)
                           (collect-places f (cdr rest-places) (cons getter getters) (cons setter setters))))))
              (call-with-places (places f)
                (collect-places f places nil nil)))
    (call-with-places forms
      (lambda (getters setters)

StarSugar

(library (iter (1))
         (export range iter-through-list iter-through-vector
                 loop map fold filter
                 collect-into-list collect-into-vector)
         (import (except (rnrs base (6)) map)
                 (only (rnrs r5rs (6)) inexact->exact)
                 (rnrs control (6))
                 (rnrs mutable-pairs (6))
                 (rnrs arithmetic fixnums (6)))
;; (iter 'next acc) => (values val iter/end?)

StarSugar

;;; case-lambda

;;; consider (case-lambda ((x y) (+ x y)) ((a b c d) (+ a b c d)))
;;; it would be nice that expand to

;;; (lambda (&rest g0)
;;;   (if (null g0)
;;;     (error "case-lambda match failure") ; <-- no argument
;;;     (let ((g1 (car g0)))
;;;       (setq g0 (cdr g0))

StarSugar

(defun solve-queens (n)
  (declare (fixnum n))
  (let ((res 0)
        (queens (make-array (* 2 n) :fill-pointer 0 :element-type 'fixnum)))
    (declare (fixnum res) (dynamic-extent queens))
    (labels ((put (row)
               (declare (fixnum row))
               (if (> row n)
                 (incf res)
                 (loop for col fixnum from 1 to n do

StarSugar

; emacs lisp version

(cl-defmacro collect (val (&rest seqs) &rest tests)
  (unless (cl-every
            (lambda (x)
              (and (listp x)
                   (= (length x) 2)
                   (symbolp (car x))))
            seqs)
    (error "Bad collect form ~A" (list* 'collect val seqs tests)))

StarSugar

#lang racket/gui

(require (for-syntax racket/match))
(require compatibility/defmacro)

(begin-for-syntax

  (define (displayf fmt . xs)
    (display (apply format fmt xs)))
  

StarSugar

#lang racket/gui

(require srfi/1)

;;; ENVIRONMENT

(struct environ (dyn caps top props))

(define (make-empty-env)
  (environ (make-immutable-hasheq) (make-immutable-hasheq) (make-hasheq) (make-weak-hasheq)))

StarSugar

#|
Copyright © 2025 Tsing

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the “Software”), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

StarSugar

#include <stdint.h>
#include <unistd.h>
#include <stdio.h>
#include <errno.h>
#include <stdarg.h>
#include <stdlib.h>

int cprint(intptr_t first, ...) {
  va_list args, args2;
  va_start(args, first);