lambda_mountain 1.12.1

parse-parsed-program                     := ();
parse-macros                             := ();
parse-suffix                             := ();

parse-program := λtoks . (tail(
   (local pme)
   (local pme2)
   (while toks (
      match toks (
         ()
         ((\: remainder) (
            (set toks remainder)
         ))
         (('macro remainder) (tail(
            (set pme (parse-one-expression remainder))
            (set remainder (tail pme))
            (set pme2 (parse-one-expression remainder))
            (set parse-macros (parse-macros (Macro( (head pme) (head pme2) )) ))
            (set toks (tail pme2))
         )))
         (('fragment ('type remainder)) (tail(
            (set pme (parse-one-expression remainder))
            (set remainder (tail pme))
            (set pme2 (parse-many-expressions remainder))
            (set parse-parsed-program ( parse-parsed-program (Type( (head pme) (head pme2) )) ))
            (set typecheck-fragment-types ( typecheck-fragment-types
               (typecheck-infer-type-compound (head pme))
            ))
            (set toks (tail pme2))
         )))
         (('fragment remainder) (tail(
            (set pme (parse-one-expression remainder))
            (set remainder (tail pme))
            (parse-expect( := remainder ))
            (set remainder (tail remainder))
            (set pme2 (parse-many-expressions remainder))
            (set parse-parsed-program ( parse-parsed-program (Fragment( (head pme) (head pme2) )) ))
            (set toks (tail pme2))
         )))
         (('type remainder) (tail(
            (set pme (parse-one-expression remainder))
            (set remainder (tail pme))
            (set pme2 (parse-many-expressions remainder))
            (set parse-parsed-program ( parse-parsed-program (Type( (head pme) (head pme2) )) ))
            (set toks (tail pme2))
         )))
         (('atom ('suffix (atype (suffix remainder)))) (tail(
            (set parse-suffix (parse-suffix (atype suffix)))
            (set toks remainder)
         )))
         (('size remainder) (tail(
            (set pme (parse-one-expression remainder))
            (set remainder (tail pme))
            (set pme2 (parse-one-expression remainder))
            (typecheck-set-size( (typecheck-infer-type-compound (head pme)) (typecheck-infer-type-compound (head pme2)) ))
            (set toks (tail pme2))
         )))
         (('import (relative-path remainder)) (tail(
            (parse-program (tokenize-file relative-path))
            (set toks remainder)
         )))
         ((key (:= remainder)) (tail(
            (set pme (parse-many-expressions remainder))
            (set parse-parsed-program ( parse-parsed-program (Global ( key (head pme))) ))
            (set toks (tail pme))
         )))
         (remainder (tail(
            (set pme (parse-many-expressions remainder))
            (set parse-parsed-program (parse-parsed-program (GExpr (head pme)) ))
            (set toks (tail pme))
         )))
      )
   ))
   (debug-memory-usage 'parse)
));

parse-macro-yield-uuids := λids program . (match program (
   ()
   ( (App( (Variable 'uuid) (Variable x) )) (
      (ids ( x (Variable (uuid())) ))
   ))
   ( (l r) (
      (parse-macro-yield-uuids( (parse-macro-yield-uuids( ids l )) r ))
   ))
   ( u ids )
));

parse-macro-substitute-uuids := λids program . (match program (
   ()
   ( (App( (Variable 'uuid) (Variable x) )) (tail(
      (local id)
      (set id program)
      (while ids (tail(
         (local bind)
         (set bind (tail ids))
         (set ids (head ids))
         (if (eq( (head bind) x )) (
            (set id (tail bind))
         ) ())
      )))
      id
   )))
   ( (l r) (
      (parse-macro-substitute-uuids( ids l ))
      (parse-macro-substitute-uuids( ids r ))
   ))
   ( a a )
));

parse-lambda := λtoks . (tail(
   (local remainder)
   (local pme)
   (set pme (parse-one-expression toks))
   (local lmb)
   (set lmb (head pme))
   (set toks (tail pme))
   (match lmb (
      ()
      ((Literal .) (tail(
         (set pme (parse-many-expressions toks))
         (set lmb (Nil (head pme)))
         (set remainder (tail pme))
         (set toks ())
      )))
   ))
   (while toks (tail(
      (set pme (parse-one-expression toks))
      (match pme (
         ()
         (((Literal .) r) (tail(
            (set pme (parse-many-expressions r))
            (set lmb (lmb (head pme)))
            (set remainder (tail pme))
            (set toks ())
         )))
         ((e ()) (tail(
            (parse-expect( . toks ))
            (set toks ())
         )))
         ((e r) (tail(
            (set lmb (App (lmb e)))
            (set toks r)
         )))
      ))
   )))	
   (lmb remainder)
));

parse-unexpect := λt . fail (UnexpectedToken t);
parse-expect := λt ts . (if (eq( t (head ts) )) () (fail (ExpectedToken t)));

parse-one-expression := λtoks . (tail(
   (local pme)
   (local remainder)
   (local expr)
   (match toks (
      ()
      ( () (tail(
         (set expr Nil)
         (set remainder ())
      )))
      ( ( \l r ) (tail(
         (set pme (parse-lambda r))
         (set expr (Lambda (head pme)))
         (set remainder (tail pme))
      )))
      ( ( \] r ) (
         (parse-unexpect (head toks))
      ))
      ( ( \[ r ) (tail(
         (set pme (parse-many-expressions r))
         (set expr (head pme))
         (set remainder (tail pme))
      )))
      ( ( \\ (\' r) ) (tail(
         (set expr (Literal \'))
         (set remainder r)
      )))
      ( ( \' (i r) ) (tail(
         (set expr (Literal i))
         (set remainder r)
      )))
      ( (a r) (tail(
         (if (is-variable a) (
            (set expr (Variable a))
         ) (
            (set expr (Literal a))
         ))
         (set remainder r)
      )))
   ))
   (expr remainder)
));

parse-many-expressions := λtoks . (tail(
   (local pme)
   (local expr)
   (local remainder)
   (while toks (tail(
      (match toks (
         ()
         ((\: tl) (tail(
            (set remainder toks)
            (set toks ())
         )))
         ((\] tl) (tail(
            (if expr () (set expr Nil))
            (set remainder tl)
            (set toks ())
         )))
         (_ (tail(
            (set pme (parse-one-expression toks))
            (if expr (
               (set expr (App( expr (head pme) )))
            ) (
               (set expr (head pme))
            ))
            (set toks (tail pme))
         )))
      ))
   )))
   (expr remainder)
));

parse-expression := λtoks . (parse-many-expressions toks);