(chapter-start ‘nydp/syntax “Provides core nydp keywords and syntax, including lazy boolean expressions, special syntax for symbols and lists, special macros for scoping, assignment, anonymous functions and more…”)
(mac and args
; returns last arg if all 'args evaluate to non-nil ; nil otherwise (if args (if (cdr args) `(if ,(car args) (and ,@(cdr args))) (car args)) 't))
(def orf args
; evaluates each arg in 'args, returns the ; first non-nil value, or nil if they are ; all nil (cond args (cond (car args) (car args) (apply orf (cdr args)))))
; returns true if ‘things is a list and the first item of the ; list is the given object (def caris (obj things)
(and (pair? things) (eq? (car things) obj)))
; evaluate ‘body if ’arg is nil (mac unless (arg . body)
`(if (no ,arg) (do ,@body)))
; looks up a key in @ ; assumes local lexical context has defined a hash called ‘@ (mac prefix-at-syntax (name . names)
`(hash-get @ ',name))
(mac at-syntax names
(if (eq? (car names) '||) `(prefix-at-syntax ,@(cdr names)) (error "unknown at-syntax: expected prefix-syntax (eg @name), got ~(join-str (car names) "@" (cdr names))")))
(def expand-colon-syntax (names)
(if (no (cdr names)) `(apply ,(car names) args) `(,(car names) ,(expand-colon-syntax (cdr names)))))
(def default-colon-syntax (names)
`(fn args ,(expand-colon-syntax names)))
(assign colon-syntax-overrides (hash))
(mac def-colon-syntax (name var . body)
`(hash-set colon-syntax-overrides ',name (fn (,var) ,@body)))
(def-colon-syntax || names
(error "Irregular ': syntax: got ~(inspect names) : not prefix-syntax : in ~(join-str (car names) ":" (cdr names))"))
(mac colon-syntax names
; handle syntax of the form a:b, which the parser expands to ; (colon-syntax a b). By default, this complains if colon is used ; as a prefix (ie it disallows ":foo"), otherwise creates a new ; function which is the composition of the functions named in its ; arguments. For example, ; (count:parts spaceship) is the same as (count (parts spaceship)) ((orf (hash-get colon-syntax-overrides (car names)) default-colon-syntax) names))
(mac bang-syntax (pfx . rest)
; handle syntax of the form !x, which the parser expands to ; (bang-syntax || x). By default, this complains if there is ; a non-empty prefix (ie it disallows x!y), otherwise it creates ; a new function which is the negation of the given named function. ; For example, ; (!eq? a 10) is the same as (no:eq? a 10), which is the same as (no (eq? a 10)) (if (no (eq? pfx '||)) (error "Irregular '! syntax: got prefix ~(inspect pfx) in ~(join-str pfx "!" rest)")) (if (cdr rest) (error "Irregular '! syntax: got suffix ~(inspect (cdr rest)) in ~(join-str pfx "!" rest)") (if (caris 'colon-syntax (car rest)) `(colon-syntax no ,@(cdar rest)) `(colon-syntax no ,(car rest)))))
(mac when (condition . body)
`(cond ,condition (do ,@body)))
(def pairs (things)
(if (no things) nil (no (cdr things)) (list (list (car things))) (cons (list (car things) (cadr things)) (pairs (cddr things)))))
;; like ‘let, but creates and assigns multiple local variables. ;; for example, “(with (a 1 b 2) (+ a b))” returns 3 (mac with (parms . body)
`((fun ,(map car (pairs parms)) ,@body) ,@(map cadr (pairs parms))))
;; create a lexical scope ;; where val is assigned to var, execute ‘body in that scope (mac let (var val . body)
`((fun (,var) ,@body) ,val))
;; creates a named, locally-scoped function ;; with the given parameter names. It is possible ;; to reference the function by its name from within ;; the function (to pass as an argument or for ;; recursive invocation) (mac rfn (name parms . body)
`(let ,name nil (assign ,name (fn ,parms ,@body))))
;; same as @rfn@, but using the name @self@ (mac afn (parms . body)
`(rfn self ,parms ,@body))
;; a mix of rfn and with; creates a locally-scoped named function with ;; the given parameter names, and invokes it with the given parameter ;; values. It is possible to reference the function by its name from ;; within the function (to pass as an argument or for recursive ;; invocation) (mac rfnwith (name params . body)
(let ppairs (pairs params) `(let ,name nil (assign ,name (fun ,(map car ppairs) ,@body)) (,name ,@(map cadr ppairs)))))
;; increments a counter and appends it to prefix ;; return value should be unique until @unique-counter@ is reset ;; @unique-counter@ is reset before compiling a new expression, so under normal circumstances, ;; the returned value is unique within an expression, but not across the entire system. ;; Don’t use these values for global variables! (def uniq (prefix)
(assign uniq-counter (+ uniq-counter 1)) (sym (join-str prefix "-" (list uniq-counter))))
(def reset-uniq-counter ()
(assign uniq-counter 0))
;; creates a lexical scope with a unique symbol assigned to ;; each variable in ‘vars ; executes the ’body. (mac w/uniq (vars . body)
(if (pair? vars) `(with ,(apply + (map (fn (n) `(,n (uniq ',n))) vars)) ,@body) `(let ,vars (uniq ',vars) ,@body)))
;; @(andify a b c)@ is equivalent to ;; @(fn args (and (apply a args) (apply b args) (apply c args)))@ ;; or more simply ;; @(fn (x) (and (a x) (b x) (c x)))@ ;; note: alias as ‘andf ?? (mac andify args
(w/uniq a2 `(fn ,a2 (and ,@(map (fn (a) `(apply ,a ,a2)) args)))))
;; lazy-evaluates each argument, returns the first ;; non-nil result, or nil if all evaluate to nil. (mac or args
(if (cdr args) (let arg (car args) (if (isa 'symbol arg) `(cond ,arg ,arg (or ,@(cdr args))) (w/uniq ora `(let ,ora ,arg (cond ,ora ,ora (or ,@(cdr args))))))) (car args)))
(mac pop (xs)
(w/uniq gp `(let ,gp (car ,xs) (assign ,xs (cdr ,xs)) ,gp)))
(def build-keyword-args (pairs)
(map (fn (ab) `(list (quote ,(car ab)) ,@(cdr ab))) pairs))
(def build-hash-get-key (name)
(if (pair? name) (if (caris 'unquote name) (cadr name) name) (list 'quote name)))
;; (build-hash-getters ‘(a b c)) => (hash-get (hash-get a ’b) ‘c) (def build-hash-getters (names acc)
(if (no acc) (build-hash-getters (cdr names) (car names)) names (build-hash-getters (cdr names) `(hash-get ,acc ,(build-hash-get-key (car names)))) acc))
(def build-hash-lookup-from (root names)
(build-hash-getters (cons root names) nil))
(mac hash-lookup (names)
(build-hash-getters names nil))
;; parser expands a.b to (dot-syntax a b) (mac dot-syntax names
`(hash-lookup ,names))
;; parser expands a$b to (dollar-syntax a b) (mac dollar-syntax (_ name)
`(,name))
(def dot-syntax-assignment (names value-expr)
(let rnames (rev names) `(hash-set ,(build-hash-getters (rev (cdr rnames)) nil) ,(build-hash-get-key:car rnames) ,value-expr)))
(def hash-get-assignment (lookup value)
`(hash-set ,@lookup ,value))
(def ampersand-expression? (name)
(and (pair? name) (caris 'ampersand-syntax (car name))))
;; (= (&key (expr)) (val)) ;; (= ((ampersand-syntax key) (expr)) (val)) ;; ‘place is ((ampersand-syntax || key) (expr)) ;; we need (hash-set (expr) ’key (val)) ;; however, ;; (= (&key.subkey (expr)) (val)) ;; ‘place is ((ampersand-syntax || (dot-syntax key subkey)) (expr)) ;; we need (hash-set (hash-get (expr) ’key) ‘subkey (val)) (def ampersand-expression-assignment (place value)
(let k (cadr:cdar place) (let hsh (cadr place) (if (caris 'dot-syntax k) (dot-syntax-assignment (cons hsh (cdr k)) value) `(hash-set ,hsh ',k ,value)))))
;; used internally by ‘destructuring-assign (def destructuring-assigns (names values acc)
(if names (if (pair? names) (destructuring-assigns (cdr names) `(cdr ,values) (cons `(= ,(car names) (car ,values)) acc)) (cons `(= ,names ,values) acc)) (rev acc)))
;; used internally by ‘assign-expr (def destructuring-assign (name value)
(w/uniq destructuring-assign `(let ,destructuring-assign ,value ,@(destructuring-assigns name destructuring-assign))))
;; used internally by ‘= macro (def assign-expr (nv)
(let name (car nv) (let value (cadr nv) (if (isa 'symbol name) `(assign ,name ,value) (caris 'dot-syntax name) (dot-syntax-assignment (cdr name) value) (caris 'hash-get name) (hash-get-assignment (cdr name) value) (ampersand-expression? name) (ampersand-expression-assignment name value) (caris 'at-syntax name) `(hash-set @ ',(caddr name) ,value) (pair? name) (destructuring-assign name value) (error "unknown assignment to place: " (inspect name))))))
;; generic assignment which unlike builtin ‘assign, knows how to assign ;; to hash keys ;; (= (hash-get (expr) ’key) (val) => (hash-set (expr) ‘key (val)) ;; (= h.k (val)) => (hash-set h ’k (val)) ;; (= h.j.k (val)) => (hash-set (hash-get h ‘j) ’k (val)) ;; (= (&key (expr)) (val)) => (hash-set (expr) ‘key (val)) ;; (= (&j.k (expr)) (val)) => (hash-set (hash-get (expr) ’j) ‘k (val)) (mac = assignments
`(do ,@(map assign-expr (pairs assignments))))
;; like ‘let, but creates and assigns multiple local variables. ;; for example, “(with (a 1 b 2) (+ a b))” returns 3 ;; ;; later variables can references earlier ones: ;; (with (a 1 b 2 c (+ a b)) (list a b c)) ;; returns (1 2 3) (mac with (assignments . body)
`((fun ,(map car (pairs assignments)) (= ,@assignments) ,@body) nil))
;; quiet assignment ; like =, but expression returns nil (mac #= (name value)
`(do (= ,name ,value) nil))
;; increment the value at ‘place by ’inc (default 1) (mac ++ (place inc) ‘(= ,place (+ ,place ,(or inc 1))))
;; decrement the value at ‘place by ’inc (default 1) (mac – (place inc) ‘(= ,place (- ,place ,(or inc 1))))
;; override previous definition to allow expressions like (def hsh.foo (arg arg2) …) (mac def-assign args ‘(= ,@args))
;; evaluate ,val and assign result to ,place only if ,place is already nil (mac or= (place val) ‘(or ,place (= ,place ,val)))
(def brace-list-hash-key (k)
(if (isa 'symbol k) `(quote ,k) (caris 'unquote k) (cadr k) k))
;; TODO instead expand to: (hash ‘k1 v1 ’k2 v2 ‘k3 v3 …) ;; TODO builtin-hash function takes care of constructing the hash (def brace-list-build-hash (args)
`(hash ,@(apply + (map (fn (kv) (list (brace-list-hash-key (car kv)) (cadr kv))) (pairs args)))))
(def build-ampersand-syntax (arg)
(if (caris 'dot-syntax arg) `(fn (obj) ,(build-hash-lookup-from 'obj (cdr arg))) `(fn (obj) ,(build-hash-lookup-from 'obj (list arg)))))
;; parser expands a&b to (ampersand-syntax a b) (mac ampersand-syntax (pfx . rest)
(if (no (eq? pfx '||)) (error "Irregular '& syntax: got prefix ~(inspect pfx) in ~(join-str pfx "&" rest)")) (if (cdr rest) (error "Irregular '& syntax: got suffix ~(inspect (cdr rest)) in ~(join-str pfx "&" rest)") (build-ampersand-syntax (car rest))))
;; override ‘brace-list-mono in order to provide a useful interpretation for “{ x }” syntax (mac brace-list-mono (arg) arg)
;; interprets “{ }” as new hash (mac brace-list-empty () ‘(hash))
;; parser expands { foo bar } to (brace-list foo bar) (mac brace-list args
(if (no args) `(brace-list-empty) (no (cdr args)) `(brace-list-mono ,(car args)) (brace-list-build-hash args)))
;; stores ,val in ,var, executes ,@body, returns ,var. Saves a line of code at the end of ;; ‘let. If ’body assigns to ‘var, the assigned value of ’var will be returned. See also ‘returning (mac returnlet (var val . body) `(let ,var ,val ,@body ,var))
;; stores ,val, executes ,@body, and returns ,val. Assumes ‘body is going to do something ;; destructive with ’val, but you want ‘val before it gets changed. Note that if ’val is mutated ;; (eg hash), the mutated value will be returned. See also ‘returnlet (mac returning (val . body) (w/uniq retval `(returnlet ,retval ,val ,@body)))
(mac ifv (var expr . body)
`(let ,var ,expr (if ,var ,@(if (cddr body) `(,(car body) (ifv ,var ,@(cdr body))) body))))
; like if, except the value of each condition is locally bound to the variable ‘it ; eg (aif (find thing) (show it)) ; source: arc.arc (mac aif (expr . body)
`(ifv it ,expr ,@body))
;; returns the nth cdr of the list ‘things (def nthcdr (n things)
(loop (> n 0) (= things (cdr things) n (- n 1))) things)
;; returns the n-th item in the list ‘things (def nth (n things)
(loop (> n 0) (= things (cdr things) n (- n 1))) (car things))
(def destructure/with (var args n)
; provides the argument expression to 'with when ; destructuring arguments are present in a 'fun definition (if (pair? args) `(,(car args) (nth ,n ,var) ,@(destructure/with var (cdr args) (+ n 1))) args `(,args (nthcdr ,n ,var))))
;; issue a warning if any arg name is the name of a macro (def fun/approve-arg-names (orig args body)
(if (pair? args) (do (fun/approve-arg-names orig (car args) body) (fun/approve-arg-names orig (cdr args) body)) args (if (hash-get macs args) (warnings/new 'arg-shadows-macro "arg " args " shadows macro " args " in arg list " orig " and body " body))))
;; used internally by ‘fun (def destructure/build (given-args new-args body next)
(if (pair? given-args) (if (sym? (car given-args)) (destructure/build (cdr given-args) (cons (car given-args) new-args) body next) (w/uniq destructure (destructure/build (cdr given-args) (cons destructure new-args) `((with ,(destructure/with destructure (car given-args) 0) ,@body)) next))) (next (rev new-args given-args) body)))
(def fun/destructuring-args (args body next)
(fun/approve-arg-names args args body) (destructure/build args nil body next))
(assign fun/expanders
(list (cons 'destructuring-args fun/destructuring-args) (cons 'core-builder (fn (args body next) `(fn ,args ,@body)))))
(def fun/expand (args body expanders)
(if expanders ((cdar expanders) args body (fn (a b) (fun/expand a b (cdr expanders))))))
;; build a ‘fn form, changing ’args and ‘body to ;; properly handle any destructuring args if present (mac fun (args . body)
(fun/expand args body fun/expanders))
;; assign (f place) to place (mac zap (f place . args)
`(= ,place (,f ,place ,@args)))