
preprocess-index-types := ();
	
preprocess := λprogram . (tail(
   (preprocess-index-typedefs program)
   (set program (preprocess-apply-macros program))
   (debug-memory-usage 'preprocess)
   program
));

preprocess-dump := λprogram . (tail(
   (while program (tail(
      (print-s (tail program))(print-s \n)
      (set program (head program))
   )))
));

preprocess-index-typedefs := λprogram . (tail(
   (while program (tail(
      (preprocess-index-typedef (tail program))
      (set program (head program))
   )))
));

preprocess-index-typedef := λterm . (match term (
   ()
   ( (Type( l ds )) (
      (preprocess-index-indices( ds 0 ))
   ))
));

preprocess-index-indices := λdef index . (match def (
   ()
   ( (App( (App( tds (Variable '|) )) body )) (tail(
      (preprocess-index-indices( tds (i2s(inc(s2i index))) ))
      (preprocess-index-index( body index ))
   )))
   ( body (
      (preprocess-index-index( body index ))
   ))
));
	
preprocess-index-index := λbody index . (match body (
   ()
   ( (Literal tag) (tail(
      (set preprocess-index-types (preprocess-index-types (tag index)))
   )))
   ( (App( (Literal tag) args )) (tail(
      (set preprocess-index-types (preprocess-index-types (tag index)))
   )))
));

preprocess-index-of-tag := λtag . (tail(
   (local indices)
   (local index)
   (set indices preprocess-index-types)
   (while indices (tail(
      (if (eq( (head(tail indices)) tag )) (
         (set index (tail(tail indices)))
      ) ())
      (set indices (head indices))
   )))
   index
));

substitute-macro-body := λkvs e . (match e (
   ()
   ((Variable n) (tail(
      (while kvs (match kvs (
         ()
         ( Accept (set kvs ()) )
         ( (ks Accept) (set kvs ks) )
         ( (ks ()) (set kvs ks) )
         ( (ks (KV(k v))) (
            (if (eq(n k)) (tail(
               (set e v)
               (set kvs ())
            )) (
               (set kvs ks)
            ))
         ))
         ( u (fail (UnrecognizedKVMacro kvs)))
      )))
      e
   )))
   ( () () )
   ( (vl vr) (
      (substitute-macro-body( kvs vl ))
      (substitute-macro-body( kvs vr ))
   ))
   ( v v )
));

try-destructure-macro := λlhs e . (match (lhs e) (
   ()
   ( ( Nil Nil ) Accept )
   ( ( (App(pl pr)) (App(el er)) ) (tail(
      (local ll)
      (set ll (try-destructure-macro(pl el)))
      (if ll (tail(
         (local rl)
         (set rl (try-destructure-macro(pr er)))
         (if rl (
            (merge-list( ll rl ))
         ) ())
      )) ())
   )))
   ( ((Literal pl) (Variable el)) (
      (if (eq( pl el )) Accept ())
   ))
   ( ((Literal pl) (Literal el)) (
      (if (eq( pl el )) Accept ())
   ))
   ( ( (App( (Literal :Literal:) (Variable pv) )) (Literal el)) (
      (if (preprocess-index-of-tag el)
         ()
         (Accept (KV( pv e )))
      )
   ))
   ( ( (App( (Literal :Variable:) (Variable pv) )) (Variable el)) (
      (Accept (KV( pv e )))
   ))
   ( ( (App( (App( (Literal :Tag:) (Variable pv) )) (Variable pt) )) (Literal el)) (
      (if (preprocess-index-of-tag el)
         (  Accept
            (KV(
               pv
               (App(
                  (App(
                      (Literal :)
                     (Literal (preprocess-index-of-tag el))
                  ))
                  (preprocess-restructure-type(parse-type( Constant+Literal+U64 )))
               ))
            ))
            (KV(
               pt
               (preprocess-restructure-type(parse-type( el )))
            ))
         )
         ()
      )
   ))
   ( ((Variable pv) e) (
      (Accept (KV( pv e )))
   ))
));

preprocess-destructure-type := λtt . (
   (preprocess-restructure-type( parse-type tt ))
);

preprocess-restructure-type := λtt . (match tt (
   ()
   ( (And( lt rt )) (
      (App(
         (Literal And)
         (App(
            (preprocess-restructure-type lt)
            (preprocess-restructure-type rt)
         ))
      ))
   ))
   ( (Array( lt rt )) (
      (App(
         (Literal Array)
         (App(
            (preprocess-restructure-type lt)
            (preprocess-restructure-type rt)
         ))
      ))
   ))
   ( (tag lts) (
      (if (is-atom tag) (
         (App(
            (Literal tag)
            (preprocess-restructure-type lts)
         ))
      ) (
         (fail (InvalidRestructureType tag lts))
      ))
   ))
   ( () (fail (InvalidRestructureType ())))
   ( tag-or-variable (
      (if (is-variable tag-or-variable) (
         (Variable tag-or-variable)
      ) (
         (Literal tag-or-variable)
      ))
   ))
));

preprocess-apply-macros := λprogram . (match program (
   ()
   ( (App( (App( (Literal :) mvar )) (Literal mtype) )) (
     (App( (App( (Literal :) (preprocess-apply-macros mvar) )) (preprocess-destructure-type mtype) ))
   ))
   ( (App( (App( (Literal :) mvar )) (Variable mtype) )) (
     (App( (App( (Literal :) (preprocess-apply-macros mvar) )) (preprocess-destructure-type mtype) ))
   ))
   ( (Literal l) (tail(
      (local suffixes)
      (set suffixes parse-suffix)
      (while suffixes (tail(
         (local sfx)
         (set sfx (tail (tail suffixes)) )
         (if (is-suffix( l sfx )) (tail(
            (local literal-type)
            (set literal-type (preprocess-restructure-type(parse-type(clone-rope((Constant+Literal+ (head(tail( suffixes ))) ))))) )
            (set program (
               (App(
                  (App(
                     (Literal ':)
                     (Literal (remove-suffix( l sfx )))
                  ))
                  literal-type
               ))
            ))
         )) ())
         (set suffixes (head suffixes))
      )))
      program
   )))
   ( (Variable l) (tail(
      (local suffixes)
      (set suffixes parse-suffix)
      (while suffixes (tail(
         (local sfx)
         (set sfx (tail (tail suffixes)) )
         (if (is-suffix( l sfx )) (tail(
            (local literal-type)
            (set literal-type (preprocess-restructure-type(parse-type(clone-rope((Constant+Literal+ (head(tail( suffixes ))) ))))) )
            (set program (
               (App(
                  (App(
                     (Literal ':)
                     (Literal (remove-suffix( l sfx )))
                  ))
                  literal-type
               ))
            ))
         )) ())
         (set suffixes (head suffixes))
      )))
      program
   )))
   ( (App( (Variable _) _ )) (preprocess-apply-maybe program) )
   ( (App( (App( (Variable _) _ )) _ )) (preprocess-apply-maybe program) )
   ( (l r) (
      (preprocess-apply-macros l)
      (preprocess-apply-macros r)
   ))
   ( u u )
));

preprocess-apply-maybe := λ program . (tail(
   (local macros)
   (set macros parse-macros)
   (while macros (match macros (
      ()
      ( (ms (Macro( lhs rhs ))) (tail(
         (local new)
         (set new (try-destructure-macro( lhs program )))
         (if new (tail(
            (set program (substitute-macro-body( new rhs )))
            (set program (parse-macro-substitute-uuids (
               (parse-macro-yield-uuids( () program ))
               program
            )))
            (set program (preprocess-apply-macros program))
         )) ())
         (set macros ms)
      )))
      ( u (fail (UnrecognizedMacro u)))
   )))
   (match program (
      ()
      ( (l r) (
         (preprocess-apply-macros l)
         (preprocess-apply-macros r)
      ))
      ( () () )
      (u u)
   ))
))
