cesar_shift.sina

{
   /* cesar shift the character  DS: [ char ] */
   dup                     /* DS: [ char char ] */
   char-is-alpha not       /* DS: [ char int ] */
   :break if               /* DS: [ char ] */
   char-to-upper           /* DS: [ char ] */
   'A' sub                 /* DS: [ char ] */
   1 add                   /* DS: [ char ] */
   'Z' 'A' sub mod         /* DS: [ char ] */
   'A' add                 /* DS: [ char ] */
} :cesar-shift-char bind

{
   /* replace each element of the list with a shifted version, DS: [ list ] */
   list-new                /* DS: [ in-list out-list(empty) ] */
   {
      /* DS: [ in-list out-list ] */
      swap                 /* DS: [ out-list in-list ] */
      list-head            /* DS: [ out-list in-list(minus head) head ] */
      cesar-shift-char     /* DS: [ out-list in-list head ] */
	  roll                 /* DS: [ head out-list in-list ] */
      roll                 /* DS: [ in-list head out-list ] */
	  swap                 /* DS: [ in-list out-list head ] */
      list-append          /* DS: [ in-list out-list ] */
      swap                 /* DS: [ out-list in-list ] */
      dup                  /* DS: [ out-list in-list in-list ] */
      list-is-empty        /* DS: [ out-list in-list int ] */
      :break if            /* exit current block if != 0, DS: [ out-list in-list ] */
      swap                 /* DS: [ in-list out-list ] */
      loop
   }                       /* DS: [ in-list out-list(empty) block ] */
   call                    /* DS: [ out-list in-list(empty) ] */
   drop                    /* DS: [ out-list ] */
} :cesar-shift bind

{
   /* execute the cesar shift algorithm on stdin, DS: [ ] */

   read-line               /* DS: [ list ] */
   dup                     /* DS: [ list list ] */
   list-is-empty           /* DS: [ list int ] */
   :break if               /* exit current block if true, DS: [ list ] */
   cesar-shift             /* DS: [ list ] */
   print-string            /* DS: [ ] */
   loop                    /* redo the current block (main) */

} :main bind

main                       /* DS: [ empty-list ] */
drop                       /* [ ] */