;; описываем как парсить объявления типов
(defgeneric parse-type-decl (context type-id args))

;; объявления структур
(defmethod parse-type-decl (context (type-id (eql :struct)) args)
 (destructuring-bind (name members) args
   ;; further impl...
   ))

;; typedef объявления
(defmethod parse-type-decl (context (type-id (eql :typedef)) args)
 (destructuring-bind (source-name aliased-name) args
   ;; further impl...
   ))

;; и т.д.

  macro whenmacro (cond, body)
  syntax ("when", "(", cond, ")", body) 
  {
    def res1 = match (cond)
    {
      | <[ $subCond is $pattren ]> with guard = null
      | <[ $subCond is $pattren when $guard ]> =>
        def res2 = match (pattren)
        {
          | PT.PExpr.Call when guard != null => 
            <[ match ($subCond) { | $pattren when $guard => $body : void | _ => () } ]>
          | PT.PExpr.Call => 
            <[ match ($subCond) { | $pattren => $body : void | _ => () } ]>
          | _ => <[ match ($cond) { | true => $body : void | _ => () } ]>
        }
        res2
      | _ => <[ match ($cond) { | true => $body : void | _ => () } ]>
    }
    res1
  }

(defmacro when (condition &rest body)
  `(if ,condition (progn ,@body)))

  macro @while (cond, body)
  syntax ("while", "(", cond, ")", body) 
  {
    def loop = Nemerle.Macros.Symbol (Util.tmpname ("while_"));

    <[ 
      $("_N_break" : global) : {
        def $(loop : name) () : void {
          when ($cond) {
            $("_N_continue" : global) : {
              $body 
            } 
            $(loop : name) ()
          }
        } 
        $(loop : name) (); 
      }
    ]>
  }

(defun while-function (predicate block)
  (if (not (funcall predicate)) (return))
  (funcall block)
  (while-function predicate block))  

(defmacro while (expression &body body)
  `(while-function (lambda () ,expression)
     (lambda () ,@body)))

(defmacro while (expression &body body)
  `(tagbody
     start (if (not ,expression) (go end))
           ,@body
           (go start)
     end))

     (method :my-method (return-type :string (doc "Return value.")) (public)
      (doc "This method does strange things.")

  grammar
  {
    any           = ['\u0000' .. '\uFFFF'];
    letter        = ['a' .. 'z'] / ['A' .. 'Z'] / '_';
    digit         = ['0' .. '9'];
    spaces        = ' '*;
    id     : Expr = (letter (digit / letter)*) spaces;
    num    : Expr = digit+ spaces;
    expr'  : Expr = '(' spaces sum ')' spaces;
    expr   : Expr = num / id / expr';
    sum    : Expr = expr ('+' spaces expr)* spaces;
    start  : Expr = spaces sum spaces !any;
  }

  macro whenmacro (cond, body)
  syntax ("when", "(", cond, ")", body) 
  {
    <[ match ($cond) { | true => $body : void | _ => () } ]>
  }

Y>(defmacro when (condition &rest body)
Y>  `(if ,condition (progn ,@body)))
Y>

    macro @while (cond, body)
    syntax ("while", "(", cond, ")", body) 
    {
        <[ 
            def loop() : void {
                when ($cond) {
                    $body;
                    loop()
                }
            } 
            loop(); 
        ]>
    }

Y>(defun while-function (predicate block)
Y>  (if (not (funcall predicate)) (return))
Y>  (funcall block)
Y>  (while-function predicate block))  

Y>(defmacro while (expression &body body)
Y>  `(while-function (lambda () ,expression)
Y>     (lambda () ,@body)))
Y>

Y>(defmacro while (expression &body body)
Y>  `(tagbody
Y>     start (if (not ,expression) (go end))
Y>           ,@body
Y>           (go start)
Y>     end))
Y>

Y>Теперь все фен-шую А что это за аццкие синтаксические штучки были? Какой функционал они добавляют?

  macro @while (cond, body)
  syntax ("while", "(", cond, ")", body) 
  {
    <[ 
      ($("_N_break" : global) : {
        def loop () : void
        {
          when ($cond)
          {
            ($("_N_continue" : global) : {
              $body
            }) : void;
            loop ()
          }
        } 
        
        loop (); 
      }) : void
    ]>
  }

  macro Break ()  syntax ("break")
  {
    <[ $("_N_break" : global) () ]>
  }
  
  macro Continue ()  syntax ("continue")
  {
    <[ $("_N_continue" : global) () ]>
  }

when (asdasd is SomeType when blah-blah)
{
    ...
}

Y>  macro whenmacro (cond, body)
Y>  syntax ("when", "(", cond, ")", body) 
Y>  {
Y>    def res1 = match (cond)
Y>    {
Y>      | <[ $subCond is $pattren ]> with guard = null
Y>      | <[ $subCond is $pattren when $guard ]> =>
Y>        def res2 = match (pattren)
Y>        {
Y>          | PT.PExpr.Call when guard != null => 
Y>            <[ match ($subCond) { | $pattren when $guard => $body : void | _ => () } ]>
Y>          | PT.PExpr.Call => 
Y>            <[ match ($subCond) { | $pattren => $body : void | _ => () } ]>
Y>          | _ => <[ match ($cond) { | true => $body : void | _ => () } ]>
Y>        }
Y>        res2
Y>      | _ => <[ match ($cond) { | true => $body : void | _ => () } ]>
Y>    }
Y>    res1
Y>  }
Y>

Y>(defmacro when (condition &rest body)
Y>  `(if ,condition (progn ,@body)))
Y>

public macro When(condition, body)
syntax ("when", "(", condition, ")", body)
{
  <[ match ($condition)
     {
       | true  => $body
       | false => ()
     }
  ]>
}

Тип                 Comon Lisp             Nemerle

Цитата кода         `( цитируемый код )    <[ цитируемый код ]>

Вставка кода        ,переменная            $переменная
из переменной
(unquote)

Вставка кода        ,@переменная           ..$переменная
из списка 
(unquote списка)

Y>  macro @while (cond, body)
Y>  syntax ("while", "(", cond, ")", body) 
Y>  {
Y>    def loop = Nemerle.Macros.Symbol (Util.tmpname ("while_"));

Y>    <[ 
Y>      $("_N_break" : global) : {
Y>        def $(loop : name) () : void {
Y>          when ($cond) {
Y>            $("_N_continue" : global) : {
Y>              $body 
Y>            } 
Y>            $(loop : name) ()
Y>          }
Y>        } 
Y>        $(loop : name) (); 
Y>      }
Y>    ]>
Y>  }
Y>

Y>(defun while-function (predicate block)
Y>  (if (not (funcall predicate)) (return))
Y>  (funcall block)
Y>  (while-function predicate block))  

Y>(defmacro while (expression &body body)
Y>  `(while-function (lambda () ,expression)
Y>     (lambda () ,@body)))
Y>

  macro @while (cond, body)
  syntax ("while", "(", cond, ")", body) 
  {
    <[ 
      ($("_N_break" : global) : {
        def loop () : void
        {
          when ($cond)
          {
            ($("_N_continue" : global) : {
              $body
            }) : void;
            loop ()
          }
        } 
        
        loop (); 
      }) : void
    ]>
  }

Y>(defmacro while (expression &body body)
Y>  `(tagbody
Y>     start (if (not ,expression) (go end))
Y>           ,@body
Y>           (go start)
Y>     end))
Y>

  macro @while (cond, body)
  syntax ("while", "(", cond, ")", body) 
  {
    <[ 
        def loop() 
        {
          when ($cond)
            $body

          loop();
        } 
        
        loop();
      }
    ]>
  }

WH>when (asdasd is SomeType when blah-blah)
WH>{
WH>    ...
WH>}
WH>

def o : option[strint] = Some("строка");

when (o is Some(value))
  doStaf(value);

def o : option[strint] = Some("строка");

match (o)
{
  | Some(value) => doStaf(value);
  | _ => () // ничего не делаем!
}

(defmacro do-primes ((var start end) &body body)
  (let ((ending-value-name (gensym)))
    `(do ((,var (next-prime ,start) (next-prime (1+ ,var)))
          (,ending-value-name ,end))
         ((> ,var ,ending-value-name))
       ,@body)))

(defmethod print-c ((statement p-qualified-type) stream) ... )

(defmethod parse-type-decl (context (id (eql 'struct)) args) ... )

("text" 1 2)

(f ("text" 1 2))

("строка" символы ...)

;sapp.scm
#lang scheme
(provide (except-out (all-from-out scheme) #%app)
         (rename-out [app #%app]))
(define-syntax-rule (app f x ...)
  ;; note that applications in the resulting pattern use our own
  ;; `#%app' implicitly
  (begin (if (string? f)
             (with-output-to-string (lambda () (printf f x ...)))
             (f x ...))))

;test.scm
#lang s-exp "sapp.scm"
("~s + ~s = ~s" 1 2 3) ;-> "1 + 2 = 3"

[f, 1, 2, 3]

MC>;("text" 1 2)
MC>;

MC>;(f ("text" 1 2))
MC>;

MC>[f, 1, 2, 3]
MC>

public Filter[T](this seq : SCG.IEnumerable[T], predicate : T -> bool) : list[T]
{
  $[ x | x in seq, predicate (x) ]
}

  macro ExpandListComprehension (params exprs : list [PExpr])
  {
    def adder =
      <[
         def cell = $(exprs.Head) :: [];
         if (head == null) {
           head = cell;
           tail = cell;
         } else {
           _N_skip_write_check (tail.tl) = cell;
           tail = cell;
         }
       ]>;
       
    def loops =
      exprs.Tail.Rev ().FoldLeft (adder,
        fun (e, acc) {
          match (ListComprehensionHelper.ExpandRange (e, acc)) {
            | Some (expr) => expr
               
            | None =>
              match (e) {
                | <[ $e1 in $e2 ]> =>
                  <[ foreach ($e1 in $e2) $acc ]>
                | cond =>
                  <[ when ($cond) $acc ]>
              }
          }
        });

    match (exprs) {
      | [<[ $second .. $last ]>] =>
        <[ $[ x | x in [$second .. $last]] ]>

      | [<[ $first ]>, <[ $second .. $last ]>] =>
        <[ $[ x | x in [$first, $second .. $last]] ]>
        
      | _ =>
        <[
            mutable head = null;
            mutable tail = null;
            $loops;
            if (head == null)
              []
            else
              head
        ]>
    }
  } 

  public module ListComprehensionHelper
  {
    [Nemerle.Macros.Hygienic]
    public ExpandRange (inrange : PExpr, acc : PExpr) : option [PExpr]
    {
      match (inrange) {
        | <[ $pat in $[$first, $second .. $last] ]>
        | <[ $pat in [$first, $second .. $last] ]> =>
          Some (<[
             mutable i = $first;
             mutable delta = $second - i;
             def last = $last;
             mutable cond = if (delta < 0) i >= last else i <= last;             
             def pre_last = unchecked (last - delta);
             
             when (delta < 0 && pre_last < last || delta > 0 && pre_last > last) // we overflowed
               delta = -delta;
               
             while (cond) {
               def $pat = i;
               if (delta < 0) 
                 cond = i >= pre_last;
               else 
                 cond = i <= pre_last;
               unchecked (i += delta);
               $acc;
             }
          ]>)
           
        | <[ $pat in $[$first .. $last] ]>
        | <[ $pat in [$first .. $last] ]> =>
          Some (<[
             mutable i = $first;
             def last = $last;
             mutable cond = i <= last;
             mutable pre_last = last;
             unchecked (pre_last--); // can't use (last - 1) since 1 might change/widen type
             def overflowed = pre_last > last;
             while (cond) {
               def $pat = i;
               if (overflowed)
                 cond = i >= pre_last;
               else
                 cond = i <= pre_last;
               unchecked (i++);
               $acc;
             }
          ]>)

        | _ => None ()
      }
    }
  }

  [PegGrammar(sum, 
  grammar
  {
    any           = ['\u0000' .. '\uFFFF'];
    letter        = ['a' .. 'z'] / ['A' .. 'Z'] / '_';
    digit         = ['0' .. '9'];
    spaces        = ' '*;
    id     : Expr = (letter (digit / letter)*) spaces;
    num    : Expr = digit+ spaces;
    expr'  : Expr = '(' spaces sum ')' spaces;
    expr   : Expr = num / id / expr';
    sum    : Expr = expr ('+' spaces expr)* spaces;
    start  : Expr = spaces sum spaces !any;
  })]
  class TestSum
  {
    // обработчики вызываемые при разборе текста
  }

def g = DefineGramar(  grammar
  {
    any           = ['\u0000' .. '\uFFFF'];
    letter        = ['a' .. 'z'] / ['A' .. 'Z'] / '_';
    digit         = ['0' .. '9'];
    spaces        = ' '*;
    id     : Expr = (letter (digit / letter)*) spaces;
    num    : Expr = digit+ spaces;
    expr'  : Expr = '(' spaces sum ')' spaces;
    expr   : Expr = num / id / expr';
    sum    : Expr = expr ('+' spaces expr)* spaces;
    start  : Expr = spaces sum spaces !any;
  });

def result = g.Parse("1 + 2");

<[ $("a" : global) ...; $("b" : dyn) ....; c ...; /* или */ $("c" : name)]>

CL-USER> (declaim  (optimize speed
                             (safety 0)
                             (space 0)
                             (debug 0)))
T
CL-USER> (defun my-func (x)
           (declare (fixnum x))
           (the fixnum (1+ x)))
MY-FUNC
CL-USER> (compile 'my-func)
MY-FUNC
NIL
NIL
CL-USER> (disassemble 'my-func)
;; disassembly of #<Function MY-FUNC>
;; formals:

;; code start: #x2083517c:
   0: 83 c0 04    addl    eax,$4
   3: f8          clc
   4: 8b 75 fc    movl    esi,[ebp-4]
   7: c3          ret

cl-user> (disassemble 'my-func)
; disassembly for my-func
; 034511BF:       4883C208         add rdx, 8
;       C3:       488BE5           mov rsp, rbp
;       C6:       F8               clc
;       C7:       5D               pop rbp
;       C8:       C3               ret

VD><[ $("a" : global) ...; $("b" : dyn) ....; c ...; /* или */ $("c" : name)]>
VD>

(define-syntax loop
  (lambda (x)
    (syntax-case x ()
      [(k e ...)
       (with-syntax
          ([break (datum->;syntax #’k ’break)]) ;Прошу прощения за вставленный форматтером коммент после стрелки, там его быть не должно
          #’(call-with-current-continuation
              (lambda (break)
                (let f () e ... (f)))))])))

(let ((n 3) (ls ’()))
  (loop
  (if (= n 0) (break ls))
  (set! ls (cons ’a ls))
  (set! n (- n 1))))

basic(
  10 SIN
  20 GOTO HELL)

A>CL-USER> (declaim  (optimize speed
A>                             (safety 0)
A>                             (space 0)
A>                             (debug 0)))
A>T
A>CL-USER> (defun my-func (x)
A>           (declare (fixnum x))
A>           (the fixnum (1+ x)))
A>MY-FUNC
A>CL-USER> (compile 'my-func)
A>MY-FUNC
A>NIL
A>NIL
A>CL-USER> (disassemble 'my-func)
A>;; disassembly of #<Function MY-FUNC>
A>;; formals:

A>;; code start: #x2083517c:
A>   0: 83 c0 04    addl    eax,$4
A>   3: f8          clc
A>   4: 8b 75 fc    movl    esi,[ebp-4]
A>   7: c3          ret
A>

module Program
{
  Inc(x : int) : int { x + 1 }
  
  Main() : void
  {
    WriteLine(Inc(5));
  }
}

0000000b  mov         ecx,6 
00000010  call        FFFFFFFFEF5EDD40

(syntax-case-rule (loop body ...)
 (with-bound #'loop (break)
   #'(call-with-current-continuation
      (lambda (break)
        (let f () body ... (f))))))

(define-syntax with-bound
  (syntax-rules ()
    ((_ ctx (id ...) e)
     (with-syntax ((id (datum->;syntax ctx (quote id))) ...) ;Тут  форматтер снова вставит ; после ->
       e))))

(define-syntax syntax-case-rule
  (syntax-rules ()
    ((_ (id . pattern) template)
     (define-syntax id
       (lambda (x)
         (syntax-case x ()
           ((id . pattern) template)))))))

VD>module Program
VD>{
VD>  Inc(x : int) : int { x + 1 }
  
VD>  Main() : void
VD>  {
VD>    WriteLine(Inc(5));
VD>  }
VD>}
VD>

VD>0000000b  mov         ecx,6 
VD>00000010  call        FFFFFFFFEF5EDD40 
VD>

* (declaim (optimize speed (safety 0) (space 0) (debug 0)))

* (defun foo () (flet ((f (x) (+ x 100))) (print (f 10))))

FOO
* (foo)

110
110
* (compile 'foo)

FOO
NIL
NIL
* (disassemble 'foo)

; disassembly for FOO
; 23B6C59A:       BAB8010000       MOV EDX, 440

;       9F:       8B0570C5B623     MOV EAX, [#x23B6C570]  ; #<FDEFINITION object for PRINT>
;       A5:       B904000000       MOV ECX, 4
;       AA:       FF7504           PUSH DWORD PTR [EBP+4]
;       AD:       FF6005           JMP DWORD PTR [EAX+5]
NIL