(ns packet.core
  (:require [clojure.string :as str]
            [clojure.math :as math]
            [clojure.zip :as zip]
            [clojure.walk :as walk]
            [packet.bytes :as bs]
            [packet.utils :as u]
            [packet.checksum]))

;;----------------------------------------------------------------------
;;在定义解析器和使用解析器时均可能用到*build*，因此均需提前按需绑定
(def ^:dynamic *build* false)
;;不进行值的合规性检查
(def ^:dynamic *skip-check* false)
;;宏展开的行号
(def ^:dynamic *line* nil)
;;给带字符串参数的字段人为增加一个空错误提示
(def ^:const BLANK-MSG "")

;;这些修饰符将把当前字段变为占位字段，同时在整体外面包装相应功能
(def wrappers #{'length 'length-of 'checksum})
;;附加额外功能的修饰符，placeholder是针对占位字段自动生成的一个修饰符，用于记录同时用于外包组合子的id
(def modifiers (conj wrappers 'with 'default 'should 'count-of 'placeholder))
;;下面这些组合子在使用时不用冠以命名空间，宏展开时会自动增加
(def combiners #{'label 'skip-until 'pattern 'raw 'token 'succeed 'fail
                 'if 'when 'case 'cond 'or 'option
                 'repeat 'while 'group 'packet 'flag
                 'fixed 'skip 'reserved 'padding '++
                 'encode 'end-of-encode})

#_"
解析器和构建器的输入和输出的形式类似，这是有意的，目的是方便统一处理。

解析器就是一个函数，输入是字节序列和环境变量
环境变量的格式为
{
 :dom 已有解析值，供后续字段引用，是一个值、映射、向量的递归结构
 :path 当前解析路径
 :pos 当前解析位置
 :flag 解析flag字段时向位字段传递的值
 :start 报文起始位置
 其他参数等
}
输出是
{
 :type :group/:repeat/nil
 :value 解析值，可能是一个值，向量的递归结构
 :pos 本字段的字节位置
 :len 本字段的字节数或位数
}

构建器也是一个函数，输入是领域对象值和环境变量，
领域对象值的类型应满足字段的要求。
环境变量的格式为
{
 :dom 整体业务值，有些字段会引用其值做条件判断等操作
 :path 当前构建路径
 :pos 当前构建位置
 :start 报文起始位置
 :flag 构建flag字段时向位字段传递的值
 其他参数等
}
构建器的输出是
{
 :type :group/nil
 :value 构建值，可能是一个字节序列，或向量的递归结构
 :pos 本字段的字节位置
 :len 本字段的字节数或位数
 :flag flag字段的值，如果没有:value，则用它生成该字段的字节序列
}

如果解析或构建过程中发生错误，则输出为
{:error 各层级的错误信息列表，外层错误在前
 其他内容
}
一个层级也可能用一个集合表示多种可能的错误原因
"

;;--------------------------------------------------------
;;一些辅助函数

(defn- list-like?
  "PersistentList和clojure.lang.Cons等输出后可视为列表的类型"
  [form]
  (seq? form))

(defn- vref?
  "是否变量引用，即以$开头的符号"
  [s]
  (and (symbol? s) (str/starts-with? (name s) "$")))

(defn- has-vref?
  "判断形式中是否变量引用，以决定是否要将其转换为以env为参数的函数"
  [expr]
  (some vref? (u/flat-all symbol? expr)))

(defn- get-vref
  [expr]
  (filter vref? (u/flat-all symbol? expr)))

(defn- symbol->path
  "将以$开头的符号转换为路径向量，如$a.-1.b替换为[:a -1 :b]
  参数s可能没有开头的$"
  [s]
  (let [n (name s)
        n (cond-> n (str/starts-with? n "$") (subs 1))]
    (mapv (some-fn parse-long keyword)
          (str/split n #"\."))))

(defn distance
  "获取当前解析位置相对于当前字段组起始位置的距离"
  [env]
  (- (:pos env) (:start env)))

(defn- replace-vref
  "替换表达式中的变量引用"
  [env expr]
  (walk/prewalk (fn [e]
                  (if (vref? e)
                    (case e
                      $$ `(:dom ~env)
                      $= `(distance ~env)
                      `(get-value ~env ~(symbol->path e)))
                    e))
                expr))

(defn- expr->fn
  "用在宏中，将表达式转换为一个单参数函数形式，这个参数将是env映射
  表达式中以$开头的符号被转换为get-value函数调用以提取对应的值
  符号$=表示当前解析位置距当前字段组有效起始位置的距离"
  [expr]
  (if (has-vref? expr)
    (let [env (gensym)]
      `(fn [~env] ~(replace-vref env expr)))
    expr))

;;---------------------------------------------------------

(defn- roll-up
  "将形式内外翻转，以求得常规算术运算的反运算形式
  x是form中的自变量符号，且在form中只出现一次
  yform是作为反函数自变量的符号或包含它的形式"
  [form x yform]
  (cond (= form x) yform
        
        (list-like? form)
        (if (= (first form) `let)
          `(let ~(second form)
             ~@(map #(roll-up % x yform) (drop 2 form)))
          (let [[f & args] form
                ;;将参数中包含自变量的形式分离出来
                xform (u/find-first (fn [arg]
                                      (->> arg
                                           (u/flat-all symbol?)
                                           (some #(= % x))))
                                    args)
                xs (remove #(= % xform) args)
                yform (case f
                        + `(- ~yform ~@xs)
                        - (if (= (first args) xform)
                            `(+ ~yform ~@xs)
                            (let [[a & xs] xs]
                              `(- ~a ~yform ~@xs)))
                        * `(/ ~yform ~@xs)
                        / (if (= (first args) xform)
                            `(* ~yform ~@xs)
                            (let [[a & xs] xs]
                              `(/ ~a ~yform ~@xs)))
                        inc `(dec ~yform)
                        dec `(inc ~yform)
                        (double float) `(math/round ~yform)
                        math/round `(double ~yform)
                        = (first xs)
                        zero? 0
                        (u/line-error *line* "不支持的运算" f))]
            (roll-up xform x yform)))
        
        :else form))

(defn- func-form?
  "判断是否是函数形式"
  [form]
  (and (list-like? form)
       (let [[f args] form]
         (and (let [ns (namespace f)]
                (or (nil? ns) (= ns "clojure.core")))
              (let [n (name f)]
                (or (= n "fn") (= n "fn*")))
              (vector? args)))))

(defn- fargs->fn
  "将某函数形式及除隐含的第一参数外的其他参数变换为一个双参数函数形式，
  这个新的函数形式有两个参数，即原第一参数和环境变量。
  原来的其他参数中的变量引用在函数体中被变换为根据环境变量求值的形式"
  [f & args]
  (let [env (gensym)
        args (map #(replace-vref env %) args)]
    (if (symbol? f)
      `(fn [x# ~env] (~f x# ~@args))
      (if (func-form? f)
        (let [[x & vargs] (second f)]
          `(fn [~x ~env]
             ;;将原函数体中的参数绑定为提供的参数，其中的变量引用已被替换
             (let [~@(interleave vargs args)]
               ~@(drop 2 f))))
        nil))))

(defn- anti-func
  "求form表达式的反函数，只限单变量的常规算术运算，单变量且只能出现一次"
  [f & args]
  (let [;;将函数符号转换成fn函数形式
        f (apply fargs->fn f args)
        ;;提取函数形式中的参数，其中第一个参数为主要自变量
        [x env] (second f)
        ;;反函数的主要自变量
        y (gensym)]
    (try (let [body (map #(roll-up % x y) (drop 2 f))]
           `(fn [~y ~env] ~@body))
         (catch Exception e nil))))
;;----------------------------------------------------


(def error "获取解析器或构建器输出中的错误信息" :error)

(def get-current-field "从环境变量中获取当前工作的字段名" :field)

(def path "从环境变量中获取当前路径" :path)

(defn- push-path
  "延伸一级安装点"
  ([env] (push-path env (get-current-field env)))
  ([env field]
   (cond-> env field (update :path conj field))))

(defn- pop-path
  "回退一级路径"
  ([env]
   (cond-> env (get-current-field env) (update :path pop)))
  ([env i]
   (update env :path pop)))

(declare get-parser-value get-field-pos get-field-len)
(defn- mount-vec
  "为安装重复字段中的值做准备"
  [env]
  (assoc-in env (into [:dom] (path env)) []))

(defn- mount
  "在当前路径下安装新解析的值，供后续字段处理时读取"
  [env output]
  (let [env (update env :fields
                    (fn [os]
                      (if (and (:embed output)
                               (nil? (:name output))
                               (:type output))
                        (into os (:value output))
                        (conj os output))))]
    (if *build*
      env
      (let [value (get-parser-value output)
            start (:start output)
            field (:name output)]
        (-> env
            (cond-> start (assoc :start start))
            (update-in (into [:dom] (path env))
                       (fn [v]
                         (let [m (if (map? v) v nil)]
                           (cond field (assoc m field value)
                                 (map? value) (merge m value)
                                 (nil? v) value
                                 :else m)))))))))

(defn- forward
  "更新输入位置，为解析下一字段做准备"
  [env output]
  ;;必须使用输出的位置，因为有的字段的有效起始位置并不与当前输入的位置相同，
  ;;如skip-until字段
  (let [pos (get-field-pos output) 
        len (get-field-len output)]
    (if (and pos len)
      (assoc env :pos (+ pos len))
      env)))

(defn- mount-and-forward
  "安装并推进"
  [env output]
  (-> env (mount output) (forward output)))

(defn- get-value*
  "获取指定变量的值，遇到向量则取最后一个的值"
  [env ks]
  (loop [v (get-in env [:dom]) ks ks]
    (let [v (loop [v v]
              (if (vector? v)
                (recur (last v))
                v))]
      (if-let [k (first ks)]
        (when-let [v (when (map? v) (get v k))]
          (recur v (rest ks)))
        v))))

(defn get-value
  "获取指定变量的值"
  [env ks]
  ;;先尝试相对路径，再逐级往上尝试绝对路径
  (loop [p (path env)]
    (if-let [v (get-value* env (into p ks))]
      v
      (if (empty? p)
        (throw (ex-info "变量不存在"
                        {:val (str/join "." (map name ks))
                         :env env}))
        (recur (pop p))))))

(defn- calc-value
  "计算f的值，如果它是函数的话，以环境变量为参数"
  [f env]
  (if (fn? f) (f env) f))

(defn get-parser-value
  "从解析器的包含各字段的位置和长度的详尽输出中提取有名字段的值，形成一个映射"
  [output]
  (let [{:keys [type value]} output]
    (case type
      :group (let [os (remove #(and (zero? (:len %)) (nil? (:from %)))
                              value)]
               (if (and (= (count os) 1) (nil? (:name (first os))))
                 (get-parser-value (first os))
                 (->> os
                      (filter #(or (:name %) (= (:type %) :group)))
                      (map #(let [v (get-parser-value %)]
                              (if-let [name (:name %)]
                                {name v}
                                ;;v必是group的值，一定是个对象
                                v)))
                      (apply merge))))
      :repeat (mapv get-parser-value value)
      value)))

(defn- get-field-pos
  "获取解析位置，注意可能返回nil"
  ([output] (:pos output))
  ([output field after?]
   (when (= (:type output) :group)
     (when-let [o (u/find-first #(= (:name %) field) (:value output))]
       (cond-> (:pos o) after? (+ (:len o)))))))

(defn- get-field-len
  "获取字段字节数，注意可能返回nil"
  ([output] (:len output))
  ([output field]
   (when (= (:type output) :group)
     (when-let [o (u/find-first #(= (:name %) field) (:value output))]
       (:len o)))))

(defn- total-length
  "两个字段间的总长度，注意这两个字段间可能有空隙，不能直接将两个字段的长度相加"
  [o1 o2]
  (-> (:pos o2) (+ (:len o2)) (- (:pos o1))))

(defn- get-builder-bytes
  "从构建器的输出中拼接字节序列，注意flag字段的输出中可能没有:value"
  [output]
  (if (= (:type output) :group)
    (mapcat get-builder-bytes (:value output))
    (or (:value output)
        (when-let [v (:flag output)]
          (u/uint->bytes v (:len output))))))

;;-------------------------------------------------
;;原始部件
(defn succeed-result
  "成功结果"
  [env v]
  {:value v
   :pos (:pos env)
   :len 0})

(defn fail-result
  "失败结果，包括所有输入参数和附加的消息"
  [input env msg & args]
  {:error (list (cond-> {:input input :env env :msg msg}
                  (not-empty args) (assoc :info args)))})

(defn succeed
  "对解析，总是成功，并返回提供的值，但不消耗数据
  对构建，不输出任何有意义的内容"
  ([] (succeed nil))
  ([v]
   (fn [input env]
     (succeed-result env v))))

(defn fail
  "总是失败的解析器"
  [msg]
  (fn [input env]
    (fail-result input env msg)))

(defn- get-repeat-count
  "得到当前字段的重复次数，它由前面某个字段指定"
  [env field]
  (some #(when-let [[f n] (::count-of %)]
           (when (= f field) n))
        (:fields env)))

(defn- get-field-length
  "获取指定字段的字节数，它由前面某个字段指定"
  [env field]
  (some #(when-let [[f n] (::length-of %)]
           (when (= f field) n))
        (:fields env)))

(defn- get-current-field-length
  "获取当前字段的字节数，它由前面某个字段指定"
  [env]
  (get-field-length env (get-current-field env)))

(defn raw
  "读取原始字节（或token）的解析器"
  ([] (raw nil))
  ([len]
   (if *build*
     (fn [tokens env]
       (let [len (or len (get-current-field-length env))
             n (count tokens)]
         ;;指定长度的字段可能没有提供，因此只是试图计算并比较
         (if (and len (not= len n))
           ;;长度不符时不妄自做截断或补零的决定
           (fail-result tokens env "长度不符")
           {:value tokens
            :pos (:pos env)
            :len n}))) 
     (fn [input env]
       (if-let [n (or len (get-current-field-length env))]
         (let [pos (:pos env)]
           (if (<= (+ pos n) (bs/size input))
             {:value (bs/get-bytes input pos n)
              :pos pos
              :len n}
             (fail-result input env "内容不足")))
         (fail-result input env "长度未定"))))))

(defn token
  "单个标记"
  []
  (if *build*
    (fn [token env]
      {:value [token]
       :pos (:pos env)
       :len 1})
    (fn [input env]
      (let [pos (:pos env)]
        (if (< pos (bs/size input))
          {:value (bs/get-byte input pos)
           :pos pos
           :len 1}
          (fail-result input env "内容不足"))))))
;;----------------------------------------------------------
;;一些基本组合子

(defn- handle-field
  "用于处理内部字段
  在env中传递当前字段的名称，解析器将从中获取自己的名称
  构建时提取对应于当前字段的值，或者采用默认值"
  [worker input env]
  (let [field (:name (meta worker))
        env (-> env (assoc :field field) push-path)
        input (if (and *build* field)
                (get input field)
                input)]
    (worker input env)))

(defn mapping
  "转换输出，f的第一个参数是解析器或构建器的完整输出值"
  [worker f & args]
  (fn [input env]
    (let [o (worker input env)]
      (if (error o)
        o
        (let [args (map #(calc-value % env) args)]
          (apply f o args))))))

(defn map-value
  "转换解析结果中的值，f的第一个参数是解析器的输出值，不包含其他信息
  对组字段和重复字段，将视为一个整体，转换后的类型是简单类型"
  [worker f & args]
  (fn [input env]
    (let [o (worker input env)]
      (if (error o)
        o
        (let [args (map #(calc-value % env) args)]
          (-> (apply update o :value f args)
              (dissoc :type)))))))

(defn map-input
  "转换输入"
  [worker f & args]
  (fn [input env]
    (let [args (map #(calc-value % env) args)
          v (apply f input args)]
      (if (= v ::invalid)
        (fail-result input env "无效数据")
        (worker v env)))))

(defn with-field-name
  "为解析器或构建器赋予名称，就是对应的字段名，为结果自动附加name信息"
  [field-name worker]
  (-> worker
      (mapping assoc :name field-name)
      (with-meta {:name field-name})))

(defmacro label
  [name]
  `(with-field-name ~(keyword name) (succeed)))

;;----------------------------------------------------------
;;利用下面的unit和flatmap函数可以将解析器实现为一个单子

;;将一个值提升为返回这个值的解析器
(def unit succeed)

(defn flatmap
  "映射解析器，f是一个函数，将解析器的输出转换为另一个解析器"
  [worker f]
  (fn [input env]
    (let [o (worker input env)]
      (if (error o)
        o
        (let [env (mount-and-forward env o)
              w (f o)]
          (handle-field w input env))))))

;;----------------------------------------------------------

(defn- scope-error
  "为解析器的输出增加一个层次的错误提示信息"
  [env output msg]
  (if-let [n (get-current-field env)]
    (update output :error conj {:field n :msg msg})
    output))

(defn- label-error
  "为当前层次附加错误消息"
  [output msg]
  (let [[e & es] (error output)
        e (update e :msg #(str msg " >> " %))]
    (assoc output :error (cons e es))))

(defn prompt
  "为解析器附加错误提示"
  [msg worker]
  (mapping worker (fn [o] (cond-> o (error o) (label-error msg)))))

(defmacro with
  "用于对解析值进线转换，构建时要逆转换，没有提供逆转换函数时自动分析
  with f1 ... and f2 ..."
  [worker f1 & args]
  (let [[args1 args2] (split-with #(not= % 'and) args)
        f1 (apply fargs->fn f1 args1)
        [f2 & args2] (rest args2)
        f2 (if f2
             (apply fargs->fn f2 args2)
             (apply anti-func f1 args1))]
    `(with-slot ~f1 ~f2 ~worker)))

(defn- invf
  "由函数f的值v求其对应的自变量的值，采用切线法解方程"
  [f v & args]
  (loop [x 1.0]
    (let [y (- (apply f x args) v)]
      (if (< (abs y) 1e-9)
        x
        (let [s (- (apply f (+ x 1.0) args) v y)]
          (recur (if (zero? s)
                   (+ x 0.1)
                   (- x (/ y s)))))))))

(defn with-slot
  "用于对解析值进行转换，构建时要逆转换
  对组字段和重复字段，将视为一个整体，转换后的类型是简单类型"
  [f1 f2 worker]
  (if *build*
    (fn [value env]
      (let [v (try (if f2
                     (f2 value env)
                     (math/round (invf f1 value env)))
                   (catch Exception e ::invalid))]
        ;;无效数据也传入，因有些构建器不关心这个数据
        (worker v env)))
    (fn [input env]
      (let [o (worker input env)]
        (-> (update o :value f1 env)
            (dissoc :type))))))

(defn enum
  "用向量或映射转换报文值，无法转换时直通"
  [worker m]
  (if *build*
    (map-input worker 
               (fn [value]
                 (or (if (vector? m)
                       (u/index-of #(= % value) m)
                       (some (fn [[k v]]
                               (when (= v value) k))
                             m))
                     value)))
    (map-value worker #(get m % %))))

(defmacro should
  "验证解析结果满足约束条件，可以是断言任何表达式
  对数值字段，常用约束条件是>、>=、<、<=、=等，
  对于等式约束，可据此计算其应然值
  should f ..."
  [worker f & args]
  (let [checker (when-not *skip-check*
                  (apply fargs->fn f args))
        setter (when (or (= f '=) (= f 'zero?))
                 (apply anti-func f args))]
    (if (or checker setter)
      `(should-slot ~checker ~setter ~worker)
      worker)))

(defn should-slot
  "验证解析结果满足约束条件
  如果在解析或构建前设置*skip-check*，则会跳过校验代码"
  [checker setter worker]
  (if *build*
    (fn [value env]
      ;;验证提供的值是否满足约束条件，或者从等式约束条件中推测必然的值
      (let [value (if (and (nil? (get-current-field env)) setter)
                    (setter value env)
                    value)]
        (if (or *skip-check* (nil? checker) (checker value env))
          (worker value env)
          (fail-result value env "违反约束条件")))) 
    (fn [input env]
      (let [o (worker input env)]
        (if (or (error o)
                *skip-check*
                (nil? checker)
                (checker (:value o) env))
          o
          (fail-result input env "违反约束条件"))))))

(defmacro default
  "为字段设置默认值，默认值可以是一个包含变量引用的表达式"
  [worker default-value]
  `(default-slot ~(expr->fn default-value) ~worker))

(defn default-slot
  [expr worker]
  (if *build*
    (fn [value env]
      (let [value (if (nil? value)
                    (calc-value expr env)
                    value)]
        (worker value env)))
    worker))

(defmacro count-of
  "另一重复字段的重复次数"
  ([worker field] `(count-of ~worker ~field 0))
  ([worker field adjust]
   (when-not (ident? field)
     (u/line-error (:line (meta &form)) "必须指定重复字段名"))
   (when-not (int? adjust)
     (u/line-error (:line (meta &form)) "调整值必须是整数"))
   `(count-of-slot ~(keyword field) ~adjust ~worker)))

(defn count-of-slot
  [field adjust worker]
  (if *build*
    (fn [value env]
      ;;根据重复字段的数据个数来设置需要构建的值
      (let [v (-> env
                  (get-in (-> [:dom]
                              (into (path env))
                              (conj field)))
                  count
                  (+ adjust))]
        (worker v env)))
    ;;解析时设置::count-of标记，共重复字段读取
    (mapping worker
             (fn [o]
               (let [n (- (:value o) adjust)]
                 (assoc o ::count-of [field n]))))))

(defmacro length-of
  "另一重复字段的重复次数"
  [worker & args]
  (let [fields (->> args (filter symbol?) (mapv keyword))
        adjust (->> args (filter number?) (apply +))]
    (when-not (int? adjust)
      (u/line-error (:line (meta &form)) "调整值必须是整数"))
    `(length-of-slot ~worker ~fields ~adjust)))

(defn length-of-slot
  [worker fields adjust]
  (if (and (not *build*) (= (count fields) 1))
    ;;解析时记录那个字段的长度，如果只涉及一个字段的话
    (let [field (first fields)]
      (mapping worker
               (fn [o]
                 (let [n (- (:value o) adjust)]
                   (assoc o ::length-of [field n])))))
    worker))

;;这两个是统一生成的修饰语宏，它们不需要特殊处理
(defmacro length [worker & args] worker)
(defmacro checksum [worker & args] worker)

;;---------------------------------------------------------------------
;;其他原子解析器

(defn fixed
  "固定内容解析器"
  [value]
  (if *build*
    (fn [i-dont-care env]
      {:value [value] :pos (:pos env) :len 1})
    (let [p (token)]
      (fn [input env]
        (let [o (p input env) v (:value o)]
          (if (and (not (error o)) (not= v value))
            (fail-result input env (str "内容不匹配，应为" value "实为" v))
            o))))))

(defn skip
  "跳过n字节"
  ;;利用raw是为了利用其越界判断
  [n]
  (if *build*
    (fn [value env]
      {:value (repeat n 0) :pos (:pos env) :len n})
    (raw n)))

(defn reserved
  "保留固定字节，解析时不判断内容是否一致"
  [& tokens]
  (if *build*
    (fn [value env]
      {:value tokens :pos (:pos env) :len (count tokens)})
    (skip (count tokens))))

(defn- pad-len
  "当前位置p离n字节边界的距离"
  [p n]
  (let [i (mod p n)]
    (if (pos? i) (- n i) 0)))

(defn padding
  "填充以对齐n字节边界，默认用0填充．注意边界从报文真正的start位置开始算起"
  ([n] (padding n 0))
  ([n byte]
   (if *build*
     (fn [value env]
       (let [p (:pos env) l (pad-len p n)]
         {:value (when (pos? l) (repeat l byte)) 
          :pos p
          :len l}))
     (fn [input env]
       (let [{:keys [start pos]} env]
         {:value byte
          :pos pos
          :len (pad-len (- pos start) n)})))))

;;---------------------------------------------------------------------
(defmacro pattern
  "匹配一个模式，模式由固定token和符号组成，符号可匹配任何token，但除?外，相同的符号需匹配相同的token"
  [& args]
  (let [xs (map #(cond-> % (symbol? %) keyword) args)]
    (if (and (= (count xs) 1) (not (keyword? (first xs))))
      `(fixed ~(first xs))
      `(pattern-slot ~@xs))))

(defn pattern-slot
  [& xs]
  (let [n (count xs)]
    (if *build*
      (fn [obj env]
        (let [bs (map #(if (keyword? %) (get obj % %) %) xs)]
          (if-let [ks (not-empty (filter keyword? bs))]
            (fail-result obj env "变量值未提供" ks)
            {:value bs :pos (:pos env) :len n})))
      (let [p (raw n)]
        (fn [input env]
          (let [o (p input env)]
            (if (error o)
              o
              (let [ys (:value o)
                    os (map (fn [i x y]
                              {:name x
                               :value y
                               :pos (+ (:pos env) i)
                               :len 1})
                            (range) xs ys)]
                (if (->> os
                         (reduce (fn [m {:keys [name value]}]
                                   (if (keyword? name)
                                     (if (= name :?)
                                       m
                                       (if (= (get m name value) value)
                                         (assoc m name value)
                                         (reduced :error)))
                                     (if (not= name value)
                                       (reduced :error)
                                       m)))
                                 nil
                                 )
                         (= :error))
                  (fail-result input env (str "模式不匹配，应为" xs "，实为" (vec ys)))
                  ;;即使:value为空，也不能embed，因为下面的:pos和:len都是有用的信息
                  {:type :group
                   :value (mapv (fn [o]
                                  (let [n (:name o)]
                                    (if (or (not (keyword? n)) (= n :?))
                                      (dissoc o :name)
                                      o)))
                                os)
                   :pos (:pos env)
                   :len n})))))))))

(defmacro skip-until
  "搜寻满足模式的位置"
  [& args]
  (let [worker (if (every? (some-fn number? string? symbol?) args)
                 `(pattern ~@args ~BLANK-MSG)
                 `(embed-group ~@args))]
    `(skip-until-slot ~worker)))

(defn skip-until-slot
  [worker]
  (if *build*
    worker
    (fn [input env]
      (let [o (handle-field worker input env)]
        (if (error o)
          (recur input (update env :pos inc))
          (assoc o :start (:pos env)))))))

;;-------------------------------------------------------------
;;以下对用户面对的报文定义形式DSL进行变换

(defn- get-bit-info
  "从位字段的简记法中提取起止序号和默认值信息"
  [form]
  (let [[tag & args] form]
    (when (symbol? tag)
      (if (or (= tag 'b) (= tag `b))
        (let [[[from to fix] args] (split-with int? args)
              from (or from 0) to (or to from)]
          [(min from to) (max from to) fix args])
        (let [ns (namespace tag)
              s (name tag) t (first s) post (subs s 1)]
          (when (and (or (nil? ns) (= ns "packet.core"))
                     (= t \b) (not (empty? post)))
            ;;位类型可写为b0-2=7的形式，表示起止位置和默认值
            (let [i (str/last-index-of post \=)
                  fix (when i (parse-long (subs post (inc i))))
                  post (cond-> post i (subs 0 i))
                  xs (map parse-long (str/split post #"\-"))]
              (when (and (<= 1 (count xs) 2) (every? int? xs))
                (let [from (first xs) to (last xs)]
                  [(min from to) (max from to) fix args])))))))))

(defn transform
  "面向用户的基本解析器的形式为
  (u 2 ... as field-name prompt-string
      with f1 ... and f2 ...
      default ...
      should predicate ...
      count-of ...
      length ...
      length-of ...
      checksum ...)
  第一个符号为字段类型，第二个数值（如有）通常是字节数，可能还有其他参数
  as后是字段名，with后是转换函数，should后是验证函数
  count-of说明本字段是某个重复字段的重复次数
  length、length-of说明本字段是报文的长度信息
  checksum说明本字段是报文校验信息
  以上信息提取完后，最后一个字符串是错误提示信息
  除了基本解析器外，可能还有组合子，组合子前不用冠以命名空间"
  [form]
  (cond (list-like? form)
        (binding [*line* (:line (meta form))]
          (let [mt (meta form)
                ;;提取名称(as的优先级最高)
                field-name (u/getf form 'as)
                form (u/removef form 'as)
                
                ;;转换和验证功能由相应的包裹组合子实现
                [form & modifiers] (u/leader-partition modifiers form)
                
                ;;对嵌入规约字段，默认以规约名为字段名
                field-name (if (and (= (first form) 'packet) (nil? field-name))
                             (second form)
                             field-name)
                msg (u/find-last string? form)
                form (remove #(= % msg) form)
                
                ;;用户面对的这些组合子名称与标准库中的名称冲突，故自动加以后缀
                ;;不递归处理内部的形式，只有它们自己才知道如何处理其内部结构
                form (let [[p & args] form]
                       (cond (#{'if 'when 'case 'cond 'repeat 'while 'or} p)
                             `(~(symbol "packet.core" (str (name p) "-macro"))
                               ~@args)
                             (contains? combiners p)
                             `(~(symbol "packet.core" (name p)) ~@args)
                             :else form))
                
                ;;位类型可写为b0-3=7这样的形式
                form (if-let [[from to fix more] (get-bit-info form)]
                       (if (and fix (>= fix (bit-shift-left 1 (inc (- to from)))))
                         (u/line-error *line* "默认值越限" fix)
                         (if-not (empty? more)
                           (u/line-error *line* "多余参数" more)
                           `(b ~from ~to ~fix)))
                       form)
                
                ;;修饰符变为包装组合子。同时处理枚举类型
                form (reduce (fn [form [t & args]]
                               (let [t (if (and (= t 'with)
                                                (let [a (first args)]
                                                  (or (map? a) (vector? a))))
                                         'enum
                                         t)]
                                 `(~(symbol "packet.core" (name t)) ~form ~@args)))
                             form
                             modifiers)
                form (if (str/blank? msg) form `(prompt ~msg ~form))]
            
            (when (and (nil? field-name) (#{'repeat 'while} (first form))
                       (not-any? #(= (first %) 'with) modifiers))
              (u/line-error *line* (str (first form) "字段必须指定名称")))
            ;;最后才包装名称，保证外层组合子能看到这个名称，这很重要
            (with-meta (if field-name
                         `(with-field-name ~(keyword field-name) ~form)
                         form)
              mt)))

        (or (number? form) (string? form)) `(fixed ~form)
        (vector? form) `(embed-group ~@form)
        
        :else
        (u/line-error *line* "无效形式" form)))

;;---------------------------------------------------------------------

(defn- handle-pattern
  "将连续的数字、字符串、符号包裹为一个pattern字段"
  [forms]
  (let [tors? (some-fn number? string? symbol?)]
    (->> forms
         (partition-by tors?)
         (mapcat (fn [forms]
                   (if (tors? (first forms))
                     (if (every? symbol? forms) 
                       (u/line-error *line* "符号泄露" forms)
                       (list `(pattern ~@forms ~BLANK-MSG)))
                     forms))))))

(defn- placeholder?
  "判断一个字段是否需要占位，构建时占位字段最后由外包组合子填充其值"
  [form]
  (and (list-like? form)
       (some wrappers (u/removef (rest form) 'as))))

(defn- get-all-bit-fields
  "获取flag字段下的所有位字段，注意位字段可能不直接在flag字段下"
  [forms]
  (mapcat (fn [form]
            (if (= (name (first form)) "if")
              (->> (drop 2 form)
                   (mapcat #(cond-> % (not (vector? %)) list))
                   get-all-bit-fields)
              (list form)))
          (filter list-like? forms)))

(defn- label-placeholders
  "标记需要占位的字段，包括flag下的位字段。就是自动增加一个placeholder修饰语
  这个标记会被group使用，用于建立外包组合子和原字段间的联系"
  ([forms] (label-placeholders forms false))
  ([forms inflag?]
   (map (fn [form]
          (cond (and (list-like? form) (= (first form) 'flag))
                (if (some placeholder? (get-all-bit-fields (rest form)))
                  (with-meta
                    `(~'flag ~@(label-placeholders (rest form) true))
                    (meta form))
                  form)
                
                (placeholder? form)
                (with-meta
                  `(~@form ~'placeholder ~(keyword (gensym)))
                  (meta form))

                (and inflag? (vector? form))
                `[~@(label-placeholders form true)]

                (and inflag? (list-like? form) (= (first form) 'group))
                `[~@(label-placeholders (rest form) true)]
                
                :else form))
        forms)))

(defn- get-holders
  "提取长度、校验等字段信息，因为占位字段本身可能没有名称，因此需要使用id来标识自身"
  [forms]
  (->> forms
       (mapcat (fn [form]
                 (if (= (first form) 'flag)
                   (filter placeholder? (get-all-bit-fields (rest form)))
                   (when (placeholder? form) (list form)))))
       (map (fn [form]
              (let [id (u/getf form 'placeholder)
                    form (u/removef form 'placeholder)
                    [basic & modis] (u/leader-partition modifiers form)
                    holders (filter #(contains? wrappers (first %)) modis)]
                (when (> (count holders) 1)
                  (u/line-error (:line (meta form)) "修饰语冲突" holders))
                (when-let [holder (first holders)]
                  (let [basic (->> modis
                                   (remove #(= % holder))
                                   (apply concat basic))]
                    [holder id basic])))))))

(defmacro embed-group
  "嵌入组的解析结果将被直接融入外部组的结果中，group-slot将检查:embed标志"
  [& forms]
  `(mapping (group ~@forms) assoc :embed true))

(defmacro group
  [& forms]
  (let [[flags forms] (split-with keyword? forms)]
    (when-not (empty? forms)
      (let [;;收集无序和可选等以关键字表示的标志
            flags (reduce #(assoc %1 %2 true) nil flags)
            ;;首先将数字符号转换为pattern字段，再标记需要占位的字段
            forms (-> forms handle-pattern label-placeholders)
            
            ;;提前提取需要包裹的字段及其序号
            holders (get-holders forms)
            ;;认为同一层级最多只有一个校验字段，并将校验字段放到最后
            checksum (u/find-first #(= (ffirst %) 'checksum) holders)
            holders (vec (remove #(= (ffirst %) 'checksum) holders))

            ;;给encode字段赋id
            forms (map (fn [form]
                         (if (= (first form) 'encode)
                           (with-meta
                             `(encode ~(keyword (gensym)) ~@(rest form))
                             (meta form))
                           form))
                       forms)
            encode-wrappers (keep (fn [[t id & args]]
                                    (when (= t `encode)
                                      [`(~'encode ~@args) id nil]))
                                  forms)
            holders (into holders encode-wrappers)
            holders (cond-> holders checksum (conj checksum))

            ;;把(break-when ...)改写为if的形式
            [fs1 fs2] (split-with #(not (and (list-like? %)
                                             (= (first %) 'break-when)))
                                  forms)
            forms (if (empty? fs2)
                    forms
                    (let [[break-when & more] fs2]
                      (concat fs1
                              (list `(if-macro ~(second break-when)
                                       (group ~@(drop 2 break-when))
                                       (embed-group ~@more))))))
            
            
            ;;即使forms只有一个，都要用group包裹，系统多处依赖于此
            form `(group-slot ~flags ~@(map transform forms))]
        ;;包裹外包组合子
        (reduce (fn [form [[tag & args] id basic]]
                  `(~(symbol "packet.core" (str tag "-wrapper"))
                    ~id
                    ~basic
                    ~form
                    ~@args))
                form
                holders)))))

(defn unordered-group
  "顺序无所谓的一组解析器，其中的解析器还可能是可选的"
  [flags & workers]
  (fn [input env]
    ;;环境变量中的fields是给外包组合子搜寻解析结果之用
    (loop [workers (apply sorted-map (interleave (range) workers))
           env (assoc env :fields [])]
      (if-let [[i worker o]
               (some (fn [[i worker]]
                       (let [o (handle-field worker input env)]
                         (when-not (error o) [i worker o])))
                     workers)]
        (recur (dissoc workers i) (mount-and-forward env o))
        (if (or (empty? workers) (:optional flags))
          (let [p (or (:pos (first (:fields env))) (:pos env))]
            {:type :group
             :value (:fields env)
             :pos p
             :len (- (:pos env) p)})
          (fail-result input env "字段缺失"))))))

(defn group-slot
  "顺序连接多个解析器
  flags中可能包含:unordered和:optional两个标志的映射"
  [flags & workers]
  (if (:unordered flags)
    (apply unordered-group flags workers)
    (fn [input env]
      ;;环境变量中的fields是给外包组合子搜寻解析结果之用
      (loop [[worker & workers] workers
             env (assoc env :fields [])]
        (if worker
          (let [o (handle-field worker input env)]
            (if (error o)
              (if (:optional flags)
                (recur workers env)
                (scope-error env o "内部字段异常"))
              (recur workers (mount-and-forward env o))))
          (let [os (:fields env)]
            (if (= (count os) 1)
              (first os)
              (let [p (or (:pos (first os)) (:pos env))]
                {:type :group
                 :value os
                 :pos p
                 :len (- (:pos env) p)}))))))))

;;标志位字段
(defmacro flag
  "根据内部出现的最大位序号计算字节数"
  [& forms]
  (let [;;获取最大位序号
        all-bits (get-all-bit-fields forms)
        ;;placeholders仅仅用来记录它下面的位字段涉及到哪些信息的占位，方便构建时填充其值
        ;;因为构建时未保留各位字段的信息，位值被加到了flag字段输出的的:flag中
        placeholders (->> all-bits
                          (keep #(when (placeholder? %) (u/getf % 'placeholder)))
                          set
                          not-empty)
        i (->> all-bits
               (map get-bit-info)
               (keep second)
               (apply max 0))]
    (when (> i 63) (u/line-error (:line (meta &form)) "位序号不能超过63"))
    `(flag-slot ~(inc (quot i 8)) ~placeholders ~@(map transform forms))))

(defn- flatten-group
  "展平group类型的解析器输出"
  [os]
  (mapcat (fn [o]
            (if (= (:type o) :group)
              (flatten-group (:value o))
              (list o)))
          os))

(defn flag-slot
  "标志字段解析器
  尽管内部包含的位字段本身不会解析失败，但可能因不满足约束条件而失败"
  [n placeholders & workers]
  (if *build*
    (fn [obj env]
      ;;如果其下有具有长度修饰符的位字段，则:flag还会被改变
      ;;因此这里暂时不把它转换为字节序列
      {:placeholders placeholders
       :flag (->> workers
                  (map #(handle-field % obj env))
                  flatten-group
                  (keep :bit)
                  (apply +))
       :pos (:pos env)
       :len n})
    (flatmap (raw n)
             (fn [o1]
               (fn [input env]
                 ;;通过env传递整个flag字段的值
                 (let [value (u/bytes->uint (:value o1))
                       env (-> env
                               (assoc :flag value :fields [])
                               (update :pos - n))]
                   (loop [workers workers env env]
                     (if-let [p (first workers)]
                       (let [o (handle-field p input env)]
                         (if (error o)
                           (scope-error env o "内部字段异常")
                           (recur (rest workers)
                                  (mount env o))))
                       {:type :group
                        :value (:fields env)
                        :pos (:pos o1)
                        :len (:len o1)
                        :flag value}))))))))

(defn b
  "特殊的位字段的解析器"
  [from to fix]
  {:pre [(int? from) (int? to) (<= from to) (or (nil? fix) (int? fix))]}
  (if *build*
    (fn [v env]
      (if (or (int? v) (int? fix))
        ;;不能用:value来保存这个值，因为:value被上层解释为字节流
        ;;有:bit表示这是位字段，外包组合子将依赖于此
        {:bit (bit-shift-left (if (int? v) v fix) from)
         :pos (:pos env)
         :len 0}
        (fail-result v env "未提供字段值")))
    (fn [input env]
      (let [n (inc (- to from))
            v (-> (unsigned-bit-shift-right (:flag env) from)
                  (bit-and (dec (bit-shift-left 1 n))))]
        (if (and fix (not= v fix))
          (fail-result input env (str "固定位不匹配，应为" fix "，实为" v))
          ;;需要将值放在:value键下，上层（如后续的变换等）有这样的要求
          ;;也需要:pos和:len信息，因为它可能被外层的if中的group包裹
          {:value v :pos (:pos env) :len 0 :from from :to to})))))

(defn packet
  "嵌入报文解析器"
  [protocol]
  (let [{:keys [name parser builder flags]} protocol]
    ;;要在新的环境下工作
    (if *build*
      (if builder
        (fn [value env]
          (binding [u/*big-endian* (not (:little-endian flags))]
            (let [o (builder value (assoc env :field nil :dom value :path []))]
              (if (error o)
                o
                (let [bs (get-builder-bytes o)]
                  {:value bs
                   :pos (:pos env)
                   :len (count bs)})))))
        (fail (str name "协议未被定义为用于构建")))
      (if parser
        (fn [input env]
          (binding [u/*big-endian* (not (:little-endian flags))]
            (parser input (assoc env :field nil :dom nil :path []))))
        (fail (str name "协议未被定义为用于解析"))))))

;;任一字段
(defmacro or-macro
  [& workers]
  `(or-slot ~@(map transform workers)))

(defn- depth
  "错误的解析位置"
  [e]
  (some #(if (sequential? %)
           (depth (first %))
           (:pos (:env %)))
        (:error e)))

(defn- cmp-depth
  "比较错误e的解析长度是否大于等于es中的解析长度"
  [e es]
  (if-let [p (some depth es)]
    (compare (depth e) p)
    1))

(defn or-slot
  "任一解析器"
  [& workers]
  (fn [input env]
    (let [workers (cond-> workers *build* reverse)]
      (loop [workers workers es []]
        (if-let [p (first workers)]
          (let [o (handle-field p input env)]
            (if-let [e (error o)]
              (recur (rest workers)
                     (case (cmp-depth e es)
                       0 (conj es e)
                       1 [e]
                       es))
              o))
          {:error (list es)})))))

(defmacro option
  "可选字段，能解析（构建）则解析（构建），不能则放弃"
  [& forms]
  `(option-slot (group ~@forms)))

(defn option-slot
  [worker]
  (fn [value env]
    (let [o (try (handle-field worker value env)
                 (catch Exception e
                   {:error :ok}))]
      (if (error o)
        (succeed-result env nil)
        o))))

;;-------------------------------------------------------------------

(defmacro repeat-macro
  "重复字段，expr可以是一个数字或一个带变量引用的表达式指定重复次数
  可以不指定重复次数，由前面带count-of修饰符的字段指定重复次数"
  [times & forms]
  (let [n (when (int? times) times)
        forms (cond->> forms (nil? n) (cons times))]
    `(repeat-slot ~n (group ~@forms))))

(defn- build-repeat
  [worker values env]
  (let [n (count values) sp (:pos env)]
    (loop [i 0 [v & vs] values env env os []]
      (if (< i n)
        (let [o (handle-field worker v (push-path env i))]
          (if (error o)
            (scope-error env o (str "第" (inc i) "个数据异常"))
            (recur (inc i)
                   vs
                   (forward env o)
                   (conj os o))))
        {:value (mapcat get-builder-bytes os)
         :pos sp
         :len (- (:pos env) sp)}))))

(defn- parse-repeat
  [worker input env pred]
  (loop [i 0 env (mount-vec env) os []]
    (if (pred (pop-path env) i)
      (let [env (push-path env i)
            o (handle-field worker input env)]
        (if (error o)
          (scope-error env o (str "第" (inc i) "次重复失败"))
          (recur (inc i)
                 (-> env (mount-and-forward o) (pop-path i))
                 (conj os o))))
      (let [p (or (:pos (first os)) (:pos env))]
        {:type :repeat
         :value os
         :pos p
         :len (- (:pos env) p)}))))

(declare repeat-until-fail)
(defn repeat-slot
  "重复解析器，重复字段必须有名称，被重复的字段可以没有名称"
  [n worker]
  (if *build*
    (fn [values env]
      (let [c (count values)
            n (or n c)]
        (if (>= c n)
          (build-repeat worker (take n values) env)
          (fail-result values env "数据个数不足"))))
    (fn [input env]
      (let [field (get-current-field env)
            n (or n (get-repeat-count env field))]
        (if (int? n)
          (parse-repeat worker input env (fn [env i] (< i n)))
          (repeat-until-fail worker input env))))))

(defn repeat-until-fail
  [worker input env]
  (loop [i 0 env (mount-vec env) os []]
    (let [env (push-path env i)
          o (handle-field worker input env)]
      (if (error o)
        (let [p (or (:pos (first os)) (:pos env))]
          {:type :repeat
           :value os
           :pos p
           :len (- (:pos env) p)})
        (recur (inc i)
               (-> env (mount-and-forward o) (pop-path i))
               (conj os o))))))

(defmacro while-macro
  "有条件重复，这个条件通常包含了当前位置$=引用，它引起条件值的变化"
  [expr & forms]
  `(while-slot ~(expr->fn expr) (group ~@forms)))

(defn while-slot
  "条件重复解析器"
  [expr worker]
  (if *build*
    (fn [values env]
      (build-repeat worker values env))
    (fn [input env]
      (parse-repeat worker input env
                    (fn [env i] (calc-value expr env))))))

(defmacro if-macro
  "条件选择"
  [expr & forms]
  (when-not (<= 1 (count forms) 2)
    (u/line-error (:line (meta &form)) "只能有1到2个字段"))
  (let [[form1 form2] forms]
    `(if-slot ~(expr->fn expr)
       ~(transform form1)
       ~(when form2 (transform form2)))))

(defmacro when-macro
  [expr & forms]
  `(if-macro ~expr ~(vec forms)))

(defn if-slot
  "条件选择"
  [expr worker1 worker2]
  (fn [input env]
    (let [c (calc-value expr env)]
      (if-let [worker (if c worker1 worker2)]
        (handle-field worker input env)
        (succeed-result env nil)))))

(defn case-range
  "将多值和值范围转换为一个向量作为解析器的键
  如(1 3 6 - 10 13)变换为[1 2 [6 10] 13]"
  [vs]
  (if (list-like? vs)
    (loop [ks [] [v & vs] vs to? false]
      (if (nil? v)
        ks
        (if to?
          (if (= v '-)
            (recur ks vs true)
            (recur (if (int? v)
                     (update ks (dec (count ks))
                             (fn [range]
                               (if (vector? range)
                                 [(first range) v]
                                 [range v])))
                     (conj ks v))
                   vs
                   false))
          (recur (cond-> ks (not= v '-) (conj v))
                 vs
                 (and (or (int? (last ks)) (vector? (last ks)))
                      (= v '-))))))
    vs))

(defmacro ++
  "仅用在case的字段部分，用于表示其他对应字段的总和"
  [& args]
  (case-range args))

(defn- find-case
  "根据值查找对应的解析器或构建器"
  [m k]
  (let [slot (or (get m k)
                 (some (fn [[ks v]]
                         (when (and (vector? ks)
                                    (some #(or (= % k)
                                               (and (vector? %)
                                                    (int? k)
                                                    (let [[a b] %]
                                                      (<= a k b))))
                                          ks))
                           v))
                       m)
                 (get m :else))]
    (if (vector? slot)
      (->> slot
           (mapcat (fn [v]
                     (if (vector? v)
                       (range (first v) (inc (last v)))
                       (list v))))
           (keep #(find-case m %))
           (apply group-slot nil))
      slot)))

(defmacro case-macro
  "根据expr的值与值与字段的对应表来选择字段"
  [expr & forms]
  `(case-slot
    ~(expr->fn expr)
    ~(->> forms
          (partition-all 2)
          (reduce (fn [m [v p]]
                    (let [worker (transform (or p v))
                          v (if p v :else)]
                      (if-let [a (when (list-like? v)
                                   (u/find-first #(and (ident? %) (not= % '-)) v))]
                        (u/line-error (:line (meta p)) "无效匹配值" a)
                        (assoc m (case-range v) worker))))
                  nil))))

(defn case-slot
  [expr worker-map]
  ;;解析与构建的代码相同
  (fn [input env]
    (let [v (calc-value expr env)]
      (if-let [worker (find-case worker-map v)]
        (handle-field worker input env)
        (fail-result input env "case没有字段匹配" v)))))

(defmacro cond-macro
  "条件与解析器的对应"
  [& forms]
  (when (odd? (count forms))
    (u/line-error (:line (meta &form)) "条件与内容要成对"))
  `(cond-slot ~(->> forms
                    (partition 2)
                    (mapv (fn [[expr form]]
                            [(if (= expr 'else)
                               :else
                               (expr->fn expr))
                             (transform form)])))))

(defn cond-slot
  [conds]
  ;;解析与构建的代码相同
  (fn [input env]
    (if-let [worker (some (fn [[expr worker]]
                            (when (calc-value expr env)
                              worker))
                          conds)]
      (handle-field worker input env)
      (fail-result input env "cond没有满足条件的分支"))))

;;---------------------------------------------------------------------------
;;其值与其他字段的长度或内容有关的字段在构建时先构建全0字节，当前组全部构建完成后再计算它们的值
;;并转换为字节序列，因此需要在组字段外再包裹一个额外的特制的字段

(defn placeholder
  "占位字段，给占位字段做个标记，以便校验时提取对应的值"
  [worker id]
  (cond-> (mapping worker assoc :placeholder id)
    ;;构建时总是先填0，最后由外包组合子自动计算并填充内容
    *build* (map-input (constantly 0))))

(defn- get-placeholder-value
  "获取id占位字段的实际值以供检查核对"
  [output id]
  (some #(when (= (:placeholder %) id) (:value %))
        (flatten-group (:value output))))

(defn- fill-placeholder
  "o1是整个字段组的输出，id是原占位字段的标识，o2是占位字段的新输出
  假设id占位字段只在当前组的顶层字段及flag字段内???"
  [o1 id o2]
  (update o1 :value
          (fn [os]
            (mapv (fn [o]
                    (if-let [v (:bit o2)]
                      ;;说明这是位字段，注意flag下可有多个占位字段，因此要累加
                      (if (contains? (:placeholders o) id)
                        (update o :flag + v)
                        o)
                      (if (= (:placeholder o) id)
                        (assoc o :value (:value o2))
                        o)))
                  os))))

(defmacro length-wrapper
  "参数包含字节数，各个引用的字段名
  最后一个形式是包装的group字段"
  [id basic wrapped & args]
  (binding [*line* (:line (meta basic))]
    (let [from (keyword (u/getf args 'from))
          to (keyword (u/getf args 'to))
          until (keyword (u/getf args 'until))
          excludes (->> args
                        (drop-while #(not= % 'excludes))
                        rest
                        (filter symbol?)
                        distinct
                        (mapv keyword)
                        not-empty)
          adjust (->> args (filter number?) (apply +))]
      (when-not (int? adjust) (u/line-error *line* "调整值必须是整数"))
      `(length-wrapper-slot ~id ~(transform basic) 
                            ~from ~to ~until ~excludes ~adjust
                            ~wrapped))))

(defn- get-fields-len
  "一些字段的长度"
  [o fields]
  (->> fields
       (keep #(get-field-len o %))
       (apply +)))

(defn- get-zone-len
  "一些字段的长度"
  [o from to until excludes]
  (let [s (if from
            (get-field-pos o from false)
            (:pos o))
        e (cond until (get-field-pos o until false)
                to (get-field-pos o to true)
                :else (+ (:pos o) (:len o)))]
    (reduce (fn [n field]
              (let [p (get-field-pos o field false)]
                (cond-> n (and (>= p s) (< p e))
                        (- (get-field-len o field)))))
            (- e s)
            excludes)))

(defn length-wrapper-slot
  "id是自动赋予的length字段的标识"
  [id basic from to until excludes adjust wrapped-group]
  (if *build*
    (mapping wrapped-group
             (fn [o]
               (let [n (+ (get-zone-len o from to until excludes)
                          adjust)]
                 (fill-placeholder o id (basic n nil)))))
    (if *skip-check*
      wrapped-group
      (fn [input env]
        (let [o (wrapped-group input env)]
          ;;比较字段的字节数之和是否与length字段的内容相符
          ;;位字段中的长度信息未记录，因此不做比较
          (if-let [l1 (when-not (or *skip-check* (error o))
                        (get-placeholder-value o id))]
            (let [len (get-zone-len o from to until excludes)
                  l2 (+ len adjust)]
              (if (not= l1 l2)
                (fail-result input env (str "字段长度为" len "，此处应为" l2 "，实为" l1))
                o))
            o))))))

(defmacro length-of-wrapper
  "参数包含字节数，各个引用的字段名
  最后一个形式是包装的group字段"
  [id basic wrapped-group & args]
  (binding [*line* (:line (meta basic))]
    (let [fields (->> args (filter symbol?) (mapv keyword))
          adjust (->> args (filter number?) (apply +))]
      (when-not (int? adjust) (u/line-error *line* "调整值必须是整数"))
      `(length-of-wrapper-slot ~id ~(transform basic) 
                               ~fields ~adjust
                               ~wrapped-group))))

(defn length-of-wrapper-slot
  "id是自动赋予的length-of字段的标识"
  [id basic fields adjust wrapped-group]
  (if *build*
    (mapping wrapped-group
             (fn [o]
               (let [n (+ (get-fields-len o fields) adjust)]
                 (fill-placeholder o id (basic n nil)))))
    (if *skip-check*
      wrapped-group
      (fn [input env]
        (let [o (wrapped-group input env)]
          ;;比较字段的字节数之和是否与length字段的内容相符
          (if-let [l1 (when-not (or *skip-check* (error o))
                        (get-placeholder-value o id))]
            (let [len (get-fields-len o fields)
                  l2 (+ len adjust)]
              (if (not= l1 l2)
                (fail-result input env (str "字段长度为" len "，此处应为" l2 "，实为" l1))
                o))
            o))))))

(defmacro checksum-wrapper
  "计算起止字段间的校验码，from指定开始字段，默认为报文开头，
  to或until指定结束字段，后者不包含指定的字段，默认为本字段前，
  用use指定计算函数，默认为packet.checksum/cs16
  校验范围包含自己的两字节校验码必须位于两字节边界上"
  [id basic wrapped-group & args]
  (binding [*line* (:line (meta basic))]
    (let [from (keyword (u/getf args 'from))
          to (keyword (u/getf args 'to))
          until (keyword (u/getf args 'until))
          cs (or (u/getf args 'use) 'packet.checksum/cs16)]
      `(checksum-wrapper-slot ~id ~(transform basic) 
                              ~from ~to ~until ~cs
                              ~wrapped-group))))

(defn checksum-wrapper-slot
  "起止字段间内容的校验码"
  [id basic from to until cs wrapped-group]
  (if *build*
    (mapping wrapped-group
             (fn [o]
               (let [os (:value o)
                     from (if from
                            (u/index-of #(= (:name %) from) os)
                            0)
                     os (if-let [e (or until to)]
                          (let [to (u/index-of #(= (:name %) e) os)
                                to (cond-> to (nil? until) inc)]
                            (subvec os from to))
                          (let [i (u/index-of #(= (:placeholder %) id) os)]
                            (subvec os from i)))
                     bs (mapcat get-builder-bytes os)]
                 (fill-placeholder o id (basic (cs bs) nil)))))
    (fn [input env]
      (let [o (wrapped-group input env)]
        (if-let [c1 (when-not (error o) (get-placeholder-value o id))]
          (let [this-o (u/find-first #(= (:placeholder %) id) (:value o))
                start (if from
                        (get-field-pos o from false)
                        (:pos o))
                end (cond until (get-field-pos o until false)
                          to (get-field-pos o to true)
                          :else (:pos this-o))
                bs (bs/get-bytes input start (- end start))
                in? (< start (:pos this-o) end)
                v (cs bs)]
            ;;校验范围包含校验码字段本身时结果通常应为0
            (if (or (and in? (not= v 0)) (and (not in?) (not= v c1)))
              (fail-result input env
                           (if in?
                             (str "校验失败")
                             (str "校验失败，应为" v "，实为" c1)))
              o))
          o)))))

;;----------------------------------------------------------

(defmacro encode-wrapper
  "设置起始标记或重新绑定字节解码器
  参数格式是所有外包组合子统一的。"
  [id _basic wrapped-group & args]
  (let [encoder (apply fargs->fn (take-while #(not= % 'and) args))]
    `(encode-wrapper-slot ~id ~encoder ~wrapped-group)))

(defn- encode-output-byte
  "给输出字节编码"
  [output encoder env]
  (update output :value
          (fn [bs]
            (let [bs (or bs
                         (when-let [flag (:flag output)]
                           (u/uint->bytes flag (:len output))))]
              (map (if (= (:type output) :group)
                     #(encode-output-byte % encoder env)
                     #(bit-and (encoder % env) 0xff))
                   bs)))))

(defn encode-wrapper-slot
  "加扰最后进行"
  [id encoder wrapped-group]
  (if *build*
    (fn [input env]
      (let [o (wrapped-group input env)
            [os1 os2] (split-with #(not= (:encode-start %) id) (:value o))
            [os2 os3] (split-with #(not (:encode-end %)) (rest os2))
            os2 (map #(encode-output-byte % encoder env) os2)]
        (assoc o :value (vec (concat os1 os2 (rest os3))))))
    wrapped-group))

(defmacro encode
  "设置起始标记或重新绑定字节解码器"
  [id & args]
  (let [[args1 [_ decoder & args2]] (split-with #(not= % 'and) args)
        decoder (if decoder
                  (apply fargs->fn decoder args2)
                  (let [encoder (apply fargs->fn args1)]
                    (apply anti-func encoder args1)))]
    (when (and (not *build*) (nil? decoder))
      (u/line-error (:line (meta &form)) "解码函数异常"))
    `(encode-slot ~id ~decoder)))

(defn encode-slot
  "对原始字节的输入和输出做变换
  字节编解码，encoder和decoder的输入输出均为字节
  group宏会将它和end-of-encode之间的内容放到本宏内
  要求worker一定是个group"
  [id decoder]
  (if *build*
    (mapping (succeed) assoc :encode-start id)
    (fn [input env]
      (set! bs/*getb* #(-> (bs/getb %1 %2)
                           (decoder env)
                           (bit-and 0xff)))
      (succeed-result env nil))))

(defn end-of-encode
  "设置结束标记或恢复字节解码器"
  []
  (if *build*
    (mapping (succeed) assoc :encode-end true)
    (fn [input env]
      (set! bs/*getb* bs/getb)
      (succeed-result env nil))))

;;---------------------------------------------------------------------------
(defn- check-bit-field
  "检查位字段是否处在不合理的位置"
  [forms inflag]
  (if inflag
    (doseq [f forms]
      (cond (list-like? f)
            (binding [*line* (or (:line (meta f)) *line*)]
              (if (or (= (first f) 'if) (= (first f) `if-macro))
                (let [forms (drop 2 f)]
                  (check-bit-field forms true))
                (when (not (get-bit-info f))
                  (u/line-error *line* "flag内只能出现位字段"))))
            (vector? f)
            (check-bit-field f true)
            :else
            (u/line-error *line* "flag内只能出现位字段")))
    (doseq [f forms]
      (cond (list-like? f)
            (binding [*line* (:line (meta f))]
              (let [flag? (= (first f) 'flag)]
                (if (get-bit-info f)
                  (u/line-error *line* "位字段只能出现在flag内")
                  (check-bit-field (u/removef (rest f) 'as) flag?))))
            (vector? f)
            (check-bit-field f false)))))

#_"
字段类型的依赖变量与产生变量作为该类型的元数据。
普通字段的产生变量就是as修饰符定义的变量。它的依赖变量就是with、default、should修饰符中引用的变量。
结构字段的依赖变量就是条件中引用的变量以及各个分支的依赖变量之和。它的产生变量是其各个分支共同的产生变量。
when结构和只有一个分支的if结构没有产生变量。

一个字段放入父组时，它的依赖变量在父组当前的产生变量中无法定位的，成为父组的依赖变量。它的产生变量加入父组的产生变量，
如果加入父组时带名字，则它的产生变量都冠以该名称。如果父组已存在同名的产生变量，则提示变量冲突。

deftype定义的类型将依赖变量与产生变量作为类型的元数据。defpacket定义的组中不应该有依赖变量。
"
#_(defn- get-dep-vals
    [form]
    (let [[t expr & args] form]
      (cond (#{'when 'if 'case 'cond 'while 'repeat} t)
            (concat (get-vref expr))
            
            )))

(defmacro defpacket
  "定义报文格式
  在名称后可用关键字指定一些选项，可能的选项有：
  parse-only,build-only,little-endian,skip-check
  系统变量要提前定义，在宏展开时使用"
  [name & forms]
  (binding [*line* (:line (meta &form))]
    (let [doc (when (string? (first forms)) (first forms))
          forms (cond-> forms doc rest)
          [flags forms] (split-with keyword? forms)
          group-flags (filter #{:unordered :optional} flags)
          flags (set flags)]
      (check-bit-field forms false)
      #_(when-let [vars (not-empty (undefined-vars forms))]
          (u/line-error line (str "变量使用前未定义:" vars)))
      `(def ^{:doc doc} ~name
         {:name ~(str name)
          :parser ~(when-not (:build-only flags)
                     `(binding [*build* false
                                *skip-check* ~(:skip-check flags)]
                        (group ~@group-flags ~@forms)))
          :builder ~(when-not (:parse-only flags)
                      `(binding [*build* true
                                 *skip-check* ~(:skip-check flags)]
                         (group ~@group-flags ~@forms)))
          :flags ~flags}))))

(defn parse
  "解析，结果带有各字段的位置和长度。如果只要各字段的值，可对结果调用get-parser-value
  如果环境变量中:skip-check为true，则除校验字段外，跳过其他字段值的检查"
  ([protocol input] (parse protocol input nil))
  ([protocol input env]
   (let [{:keys [parser flags]} protocol]
     (if parser
       (binding [u/*big-endian* (not (:little-endian flags))
                 *skip-check* (:skip-check env)
                 bs/*getb* bs/getb
                 *build* false]
         (let [start (or (:pos env) 0)]
           ;;env中可能含有用户预先提供的:dom内容，因此不要将其设为nil
           (parser input (assoc env :path [] :start start :pos start))))
       (fail (str (:name protocol) "协议未被定义为用于解析"))))))

(defn build
  "构建"
  ([protocol value] (build protocol value nil))
  ([protocol value env]
   (let [{:keys [builder flags]} protocol]
     (if builder
       (binding [u/*big-endian* (not (:little-endian flags))
                 *build* true]
         (let [value (if (and (map? env) (map? value))
                       (merge (:dom env) value)
                       value)
               start (or (:pos env) 0)
               env (assoc env :dom value :path [] :start start :pos start)
               o (builder value env)]
           (if (error o)
             o
             (vec (get-builder-bytes o)))))
       (fail (str (:name protocol) "协议未被定义为用于构建"))))))


;;=======================================================================

(defn test-packet
  "提供字节流或对象，测试解析构建后是否一致"
  [protocol bytes]
  (let [bytes (if (map? bytes)
                (build protocol bytes)
                bytes)]
    (if (and (map? bytes) (error bytes))
      (println "提供的对象无法构建" bytes)
      (let [o (parse protocol bytes)]
        (if (error o)
          (println "解析出错：" o)
          (let [{:keys [pos len]} o
                obj (get-parser-value o)
                o (build protocol obj)]
            (if (and (map? o) (error o))
              (println "构建出错：" o)
              (let [bytes (->> bytes
                               (drop pos)
                               (take len)
                               (mapv #(bit-and % 0xff)))
                    o (mapv #(bit-and % 0xff) o)]
                (when (or (not= (count bytes) (count o))
                          (some (fn [[a b]] (not= a b))
                                (map #(-> [%1 %2]) bytes o)))
                  (println "构建结果不一致")
                  (println "原始字节序列为" bytes)
                  (println "构建字节序列为" o))))))))))