rendered paste body(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)))))))
)