(evll-def (def matchfail (format . args) (apply error (strcat "Matching fail: " format) args)) ;; A place here is something you can bind to. For example, a symbol, or ;; (list a b). ;; ;; fn* is like fn, but the functions it creates only take one argument. (macenv fn* env (place . body) (cond ;; Require equality (number? place) `(fn* ',place ,@body) ;; Usual let behaviour: bind a symbol (symbol? place) (if (or (null place) (keyword? place) (and (finddb place env) (not (eq '_ place)))) ;; Require equality `(fn* ',place ,@body) ;; Bind a fresh symbol `(fn (,place) ,@body)) ;; bind a fn-macro (cons? place) (with-gensyms valsym (cond (eq (car place) 'cons) (do (assert (eq (length place) 3) "fn*/cons: illegal syntax: ~s" place) `(fn (,valsym) (assert (cons? ,valsym) "fn*/cons/runtime: can't match ~s to ~s." ,valsym ',place) (let* ,(second place) (car ,valsym) (let* ,(third place) (cdr ,valsym) ,@body)))) (eq (car place) 'list) (if (cdr place) ;; > 0 elements `(fn (,valsym) (assert (and (list? ,valsym) (eq (length ,valsym) ,(- (length place) 1))) "fn*/list/runtime: wrong list for ~s: ~s." ',place ,valsym) (let* (cons ,(cadr place) (list ,@(cddr place))) ,valsym ,@body)) ;; 0 elements, we already implemented that `(fn* nil ,@body)) (eq (car place) 'quote) ;; Require equality `(fn (,valsym) (assert (eq ,valsym ,place) "Failed to match ~s to ~s (~s)." ,valsym ,place ',place) ,@body) t (error "Unknown fn*-place: ~a" (car place)))) t (error "Unknown fn*-place ~s" place))) (mac let* (place val . body) `((fn* ,place ,@body) ,val)) (mac matchor cases (cond (null cases) (error "(matchor) is illegal.") ;; Single case (null (cdr cases)) (car cases) ;; Multiple cases t (with-gensyms k `(call/cc (fn (k) (let matchfail (fn _ (matchor ,@(cdr cases))) ,(car cases))))))) )