(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)))