[-*- Mode: emacs-lisp -*-]
[
Copyright 2011 Ken Takusagawa

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
]

[-----grammar
 (gz start (prog))
 (gz prog (module))
 (gz module (id language-pragma-opt exports imports topdecl-star
                ::pr("[[language-pragma-opt]]module [[id]] [[exports]] where{\n[[imports]]\n"
                     "[[topdecl-star('',';\n','\n')]]}\n\n")))
 (gz language-pragma ( :language-pragma f id-non-star j
                                        ::pr
                                        ("{-# LANGUAGE [[id-non-star('',',','')]] #-}\n")))
 (gz exports (f export-star j
                ::pr("[[export-star('(',', ',')')]]")) (:export-everything ::pr("")))
 (gz export (id)
     (f :module-export id j ::pr("module [[id]]"))
     )
 (gz imports (f import-star j
                ::pr("[[import-star('',';\n',';\n')]]")))
 (gz import(id ::pr( "import [[id]]"))
     (f :qualified (original-name ::is id) (new-name ::is id) j
        ::pr ( "import qualified [[original-name]] as [[new-name]]"))
     (f :specific id id-non-star j
        ::pr ("import [[id]][[id-non-star('(',',',')')]]"))
     )

 (gz type-class (f decl-mark (class-name ::is id) :type-class context-opt  id-non-plus f type-class-decl-star j j
                   ::pr("class [[context-opt]][[class-name]] [[id-non-plus('',' ','')]] where{\n"
                        "[[type-class-decl-star('',';\n','\n')]]}")))
 (gz topdecl (decl) (data)(type-synonym)(newtype)(instance)(type-class))
 (gz type-class-decl (type-signature)(decl))
 (gz type-signature (f :tysig name ret-type-and-params j
                       ::pr("[[name]] :: [[ret-type-and-params]]")))
 (gz instance (f :instance (type ::is id) (name ::is simpletype)  decls j
                 ::pr ("instance [[type]] ([[name]]) where [[decls]]")))
 [(gz instance (f :instance context-opt (type ::is id) simpletype-plus :x decls j
                  ::pr ("instance [[context-opt]][[type]] [[simpletype-plus('(',')(',')')]] where [[decls]]")))]
 (gz newtype (f decl-mark (name ::is id) :newtype type-vars-opt  constr-or-wrap deriving-opt j
                ::pr("newtype [[name]] [[type-vars-opt]] = [[constr-or-wrap{my_name}]][[deriving-opt]]")))
 (gz constr-or-wrap ::gets "tr-id*{name}" (constr)(wrap-constr ::pr("[[wrap-constr{name}]]")))
 (gz wrap-constr ::gets "tr-id*{name}"
     ( :wrap id
             ::pr(
                  (::c "name->print();")
                  " {un_"
                  (::c "name->print();")
                  " :: [[id]]}")))

 (gz deriving (:deriving f id-non-plus j
                         ::pr(" deriving [[id-non-plus('(',', ',')')]]")))
 (gz id-non (id))
 (gz type-synonym (f decl-mark id :type-synonym type-vars-opt type j
                     ::pr("type [[id]] [[type-vars-opt]] = [[type]]")))
 (gz data (f decl-mark id :data type-vars-opt constrs deriving-opt j ::pr("data [[id]] [[type-vars-opt]] = [[constrs]][[deriving-opt]]")))
 (gz simpletype (f id-non-plus j ::pr ("[[id-non-plus('',' ','')]]")))
 (gz type-vars (:args f id-non-star j ::pr ("[[id-non-star('',' ','')]]")))
 (gz constrs(constr-star ::pr("[[constr-star('',' | ','')]]"))

     )
 (gz field-type-and-param (f param type j
                             ::pr("[[param]] :: [[type]]")))
 (gz type-and-param ( f param type j ::pr("[[type]]")))
 (gz constr(positional-constructor) (field-label-constructor) )
 (gz field-label-constructor(f type-ctor :field field-type-and-param-star j
                               ::pr("[[type-ctor]][[field-type-and-param-star('{',', ','}')]]")))

 (gz decls (  decl-star  ::pr("{[[decl-star('\n',';\n','\n')]]}\n")))
 (gz context (:context f a-context-plus j ::pr
                       ("[[a-context-plus('(',', ',')')]] => ")))
 (gz a-context [(f (type ::is id) id-non-plus j
                   ::pr("[[type]] [[id-non-plus('',' ','')]]"))]
     (f (class ::is id) type-plus j
        ::pr("[[class]] [[type-plus('(',')(',')')]]"))
     )
 (gz forall (:forall f id-non-plus j
                     ::pr("forall [[id-non-plus('',' ','')]] . ")))
 (gz ret-type-and-params
     (type f type-and-param-star j forall-opt context-opt
           ::pr("[[forall-opt]][[context-opt]][[type-and-param-star('',' \x2d> ','')]]"
                (::c "if(my_type_and_param_star->v.size()>0)out(' \x2d> ');")
                "[[type]]")))

 (gz decl (f decl-mark name :fun ret-type-and-params  expr j
             ::pr("[[name]] :: [[ret-type-and-params]];\n"
                  "[[name]]"
                  (::c "for(many_trees::const_iterator pos = my_ret_type_and_params->my_type_and_param_star->v.begin();pos!= my_ret_type_and_params->my_type_and_param_star->v.end();++pos){"
                       "const tr_type_and_param* t=dynamic_cast<const tr_type_and_param*>(*pos);"
                       "assert(t);"
                       "out(' ');"
                       "t->my_param->print();" "}")
                  " = [[expr]]"))
     (f decl-mark name :fun :no-sig ret-type-and-params  expr j
        ::pr("[[name]]"
             (::c "for(many_trees::const_iterator pos = my_ret_type_and_params->my_type_and_param_star->v.begin();pos!= my_ret_type_and_params->my_type_and_param_star->v.end();++pos){"
                  "const tr_type_and_param* t=dynamic_cast<const tr_type_and_param*>(*pos);"
                  "assert(t);"
                  "out(' ');"
                  "t->my_param->print();" "}")
             " = [[expr]]"))
     (f decl-mark name :simple  expr j
        ::pr("[[name]] = [[expr]]"))
     )
 (gz name (id))
 (gz positional-constructor ["this one is sketchy"]
     (type-ctor ::pr("[[type-ctor]]"))
     (f   type-ctor typepls-opt j
          ::pr("[[type-ctor]][[typepls-opt]]"))
     (f :tuple type-plus j
        ::pr("[[type-plus('(',', ',')')]]"))
     )
 (gz pattern
     (id)
     (f  pattern-ctor pattern-star j
         ::pr ("([[pattern-ctor]] [[pattern-star('',' ','')]])"))

     (f pattern-ctor :fpat f fpat-star j j
        ::pr ("[[pattern-ctor]][[fpat-star('{',', ','}')]]"))

     (f :ptuple pattern-plus j [pattern-plus cuz :nil exists for empty lists]
        ::pr("[[pattern-plus('(',', ',')')]]"))

     (f :plist pattern-plus j [pattern-plus cuz :nil exists for empty lists]
        ::pr("[[pattern-plus('\x5b',', ','\x5d')]]"))

     (f :pchar astring j ::pr("(\x27[[astring]]\x27)"))

     (f :pstring astring j ::pr("\x22[[astring]]\x22"))

     (f :as id pattern j ::pr("[[id]]@[[pattern]]"))
     )
 (gz pattern-ctor (id) (:cons ::pr ("(:)")) (:nil ::pr ("[]")))

 (gz fpat (f (variable ::is id) pattern j
             ::pr("[[variable]] = [[pattern]]")))

 (gz type
     (f :fn ret-type-and-params j ::pr ("([[ret-type-and-params]])")) (:unit ::pr("()"))
     (positional-constructor))
 (gz typepls (paren-type-plus))
 (gz paren-type (type ::pr( "([[type]])"))
     (f :strict type j ::pr("!([[type]])"))
     (f :generic id j ::pr (" [[id]] ")))
 (gz type-ctor(id)(:list ::pr ("[]"))(:nondet ::pr ("[]")))
 (gz param (pattern))
 (gz qastring  (astring ::pr("\x22[[astring]]\x22")))

 (gz expr (id) (:mcons ::pr ("(:)")) [(:nil ::pr ("[]"))]
     (f :chain astring expr-plus j ::pr 
        ([("[[expr-plus('(',' op ',')')]]")]
         "("
         (::c "for(many_trees::const_iterator pos=my_expr_plus->v.begin();pos!=my_expr_plus->v.end();++pos){")
         (::c "if(pos!=my_expr_plus->v.begin()){")
         "[[astring]]"
         (::c "}(*pos)->print();}")
         ")"
        ))
     (f :join expr-plus j ::pr("[[expr-plus('(',' >>= ',')')]]"))
     (f :cc expr-star j ::pr ("[[expr-star('(',' ++ ',')')]]"))

     (f :rpipe expr-plus j ::pr[("[[expr-star('(',' $ ',')')]]")]
        (["http;//gcc.gnu.org/bugzilla/show_bug.cgi?id=11729"]
         (::c "for(many_trees::reverse_iterator pos = my_expr_plus->v.rbegin();"
              "pos!=my_expr_plus->v.rend();++pos){")
         "("
         (::c "(*pos)->print();" "}")
         (::c "for(many_trees::const_iterator pos = my_expr_plus->v.begin();"
              "pos!=my_expr_plus->v.end();++pos){")
         ")"
         (::c  "}")
         )
        )
     (f :rcompose expr-plus j ::pr
        ("("
         (::c "for(many_trees::reverse_iterator pos = my_expr_plus->v.rbegin();"
              "pos!=my_expr_plus->v.rend();++pos){")
         (::c "if(pos!=my_expr_plus->v.rbegin())")
         " . "
         (::c "(*pos)->print();" "}")
         ")"
         )
        )

     (qastring)
     (f :lit astring j ::pr("[[astring]]"))

     (f :ty type expr j ::pr("([[expr]] :: [[type]])"))
     (f (fun-name ::is expr) expr-star j
        ::pr ("([[fun-name]][[expr-star(' ',' ','')]])"))
     (f :do  stmt-star  j ::pr("(do{\n[[stmt-star('  ','\n  ','\n')]]})"))
     (f :case expr  alt-star  j
        ::pr("(case [[expr]] of {\n[[alt-star('  ',';\n  ','\n')]]})"))
     (f :case expr alt-star :else (underbar ::is expr) j
        ["the else is there so the grammar does not have a reduce/reduce conflict"]
        ::pr("(case [[expr]] of {\n[[alt-star('  ',';\n  ',';\n')]]"
             "  _ -> [[underbar]]\n"
             "})"))
     (f :lcase alt-star j
        ::pr("(\x5clambda_case_var ->"
             "case lambda_case_var of {\n"
             "[[alt-star('  ',';\n  ','\n')]]})"))
     (f :lcase alt-star :else (underbar ::is expr) j
        ::pr("(\x5clambda_case_var ->"
             "case lambda_case_var of {\n"
             "[[alt-star('  ',';\n  ',';\n')]]"
             "  _ -> [[underbar]]\n"
             "})"))

     (f :let decl-star expr j
        ::pr("(let {[[decl-star('\n',';\n','\n')]]}\n in [[expr]])"))
     (f :rlet expr decl-star j
        ::pr("(let {[[decl-star('\n',';\n','\n')]]}\n in [[expr]])"))
     (f :cfd expr assignments-star j
        ::pr("([[expr]][[assignments-star('{',', ','}')]])"))
     (f :mlist expr-star j ::pr("[[expr-star('\x5b',', ','\x5d')]]"))
     (f :cons-list expr-star j ::pr("[[expr-star('(',':',')')]]"))
     (f :mtuple expr-star j ::pr("[[expr-star('(',', ',')')]]"))
     (:nothing  ::pr ("()"))

     (f :lambda name ret-type-and-params expr j
        ::pr("(let {[[name]] :: [[ret-type-and-params]];\n"
             "[[name]]"
             (::c "for(many_trees::const_iterator pos = my_ret_type_and_params->my_type_and_param_star->v.begin();pos!= my_ret_type_and_params->my_type_and_param_star->v.end();++pos){"
                  "const tr_type_and_param* t=dynamic_cast<const tr_type_and_param*>(*pos);"
                  "assert(t);"
                  "out(' ');"
                  "t->my_param->print();" "}")
             " = [[expr]]} in [[name]])"))
     (f :lambda-simple id-non expr j
        [recommended only for reordering arguments to functions
                     and other simple expressions]
        [only one variable to keep it simple]
        ::pr ("(\x5c[[id-non]] -> [[expr]])"))
     (f :field-edit expr field-edit-plus j
        [plus is required by Haskell]
        ::pr("([[expr]][[field-edit-plus('{',',','}')]])"))
     )
 (gz field-edit (f id expr j ::pr ("[[id]] = [[expr]]")))

 (gz assignments (f id expr j ::pr("[[id]] = [[expr]]")))
 (gz stmt (expr ::pr("[[expr]];"))
     (f ":=" pattern type expr j ::pr("[[pattern]] :: [[type]] <- [[expr]];"))
     (f :dlet decl-star j ::pr ("let {[[decl-star('\n',';\n','\n')]]};"))
     )
 (gz alt (f  pattern expr-or-gpat j
             ::pr("[[pattern]][[expr-or-gpat]]")))
 (gz expr-or-gpat
     (expr ::pr ("-> [[expr]]"))
     (where-opt :gpats pred-expr-star [silly lookahead limitation]
        ::pr ("\n[[pred-expr-star('','','')]] [[where-opt]]"
              )))
 (gz pred-expr ( f (pred ::is expr) (do ::is expr) j
                   ::pr ("| [[pred]]\n -> [[do]]\n")))
 (gz where (:where decls ::pr ("where [[decls]]")))

 (gz decl-mark (":"))
 ]



Main :language-pragma
(
 ScopedTypeVariables
 [PatternSignatures]
 GeneralizedNewtypeDeriving
 [NoMonomorphismRestriction]
 )
(main)
(
 Data.Maybe
 System.Environment
 Debug.Trace
 Data.Tree.NTree.Zipper.TypeDefs
 Data.Tree.Class
 Data.Tree.NTree.TypeDefs
 Data.Tree.NavigatableTree.Class
 Data.List
 System.IO
Control.Monad
 )

(: main :fun (IO :unit) ()
   (:join
    getArgs
    (:lcase
     ((:nil)(:join(read-eval-print-loop mkEmpty)print-tree))
     ((:plist(:pstring "run"))run)
     ((:plist(:pstring "repl"))(:join(read-eval-print-loop two-to-connect)print-tree))
     )
    ))
(: Node :type-synonym (:tuple (Maybe String) Mydata))
(: Nnode :type-synonym (NTree Node))
(: Mydata :type-synonym :unit)
(: Edit :type-synonym (NTZipper Node))
(: no-data :fun Mydata () :nothing)
(: make-node :fun Node ((s String))
   (:mtuple (Just s) no-data))
(: placeholder :fun Node ()
   (:mtuple Nothing no-data))
(: empty-tree :fun Nnode()
   (list-make(:mlist)))
(: leaf-make :fun Nnode((s String))
   (mkTree (make-node s)(:mlist)))
(: list-make :fun (:fn (t Node)((l(:list (t Node)))))()
   :context((Tree t))
   (mkTree placeholder))
   
(: mkEmpty :fun Edit()
   (fromTree empty-tree))
(: run :fun (IO :unit)()
   (:do
    (:rpipe mkEmpty make-child-here mvDown fromJust add-tree-left fromJust
            (set-val (make-node "hello")) print)
    (:rpipe sample print-tree)
    (:rpipe to-promote-sample left-promote fromJust mvUp fromJust print-tree)
    (:rpipe to-promote-sample right-promote fromJust mvUp fromJust print-tree)
    ))
                           
(: add-tree-left :fun (Maybe Edit) ((t Edit))
   (addTreeLeft empty-tree t)
)
(: add-tree-right :fun (Maybe Edit) ((t Edit))
   (addTreeRight empty-tree t)
)

(: edit-node :fun (nt a) ((f (:fn (t a)((in (t a)))))(t (nt a)))
   :context((NavigatableTreeToTree nt t)
            (NavigatableTreeModify nt t)
            )
   (substThisTree (:rpipe t toTree f) t))
(: EE :type-synonym (:fn Edit((t Edit))))
(: make-child-here :fun EE()
   (edit-node (setChildren (:mlist empty-tree))))
(: set-val :fun EE ((x Node))
   (edit-node (setNode x)))

(: show-tree :fun String ((x (t Node)))
   :context ((Tree t))
   (:case (:rpipe x getNode fst)
          (Nothing
           (:rpipe
            x getChildren (map show-local-tree)
            (intersperse " ") concat)
           )
          :else
          (error "data node at root")
          ))
(: show-local-tree :fun String ((x (t Node)))
   :context ((Tree t))
   (:case (:rpipe x getNode fst)
          ((Just j)
           (:case (getChildren x)
                  ((:nil)j)
                  :else
                  (error (:cc "internal data node:" (show j)))))
          :else
          (:cc
           "("
           (:rpipe
            x getChildren (map show-local-tree)
            (intersperse " ") concat)
           ")")))

(: print-tree :fun (:fn(IO :unit)((x(t Node))))()
   :context ((Tree t))
   (:rcompose show-tree putStrLn))

(: push-down-node :fun (t Node)((input (t Node)))
   :context((Tree t))
   (list-make(:mlist input)))

(: push-down :fun EE ()
   (edit-node push-down-node))
   
(: this-down-right :fun Edit ((z Edit))
   (:case (:rpipe z context)
          ((:cons(NTC(left)(parent)(right))(rest-context))
           (:let
            (: new-node :fun Nnode ()
               (list-make(:mcons (ntree z)right)))
            (NTZ new-node
                 (:mcons(NTC left parent (:mlist))rest-context))
            ))))
           

[
old a - x y z
new a - x pp(y z)

old ntree y context1 x a z,
new ntree pp(y z) context x a ()
]
(: this-down-left :fun Edit ((z Edit))
   (:case (:rpipe z context)
          ((:cons(NTC(left)(parent)(right))(rest-context))
           (:let
            (: new-node :fun Nnode ()
               (list-make (endcons left (ntree z))))
            (NTZ new-node
                 (:mcons(NTC (:mlist) parent right)rest-context))
            ))))

(: endcons :fun (:list a) ((init(:list a))(last a))
   [finger trees later]
   (++ init (:mlist last)))

(: to-promote-sample :fun  Edit()
   (:rpipe sample mvDown fromJust mvRight fromJust mvRight fromJust mvDown fromJust mvRight fromJust mvRight fromJust))
[
(a b (c d e f) g h)
(a b (c d) e f g h)

promote all children would have the minor nit of where to put the cursor

a - x pp(y z)
NTZ {ntree = NTree (Just "z",()) [], context = [
                                                NTC [NTree (Just "y",()) []] (Just "pp",()) [],
                                                    NTC [NTree (Just "x",()) []] (Just "a",()) []]}

]
(: sample1 :fun Edit ()
   (fromTree(NTree (make-node "root")
                   (:cc
                    (map leaf-make (words "a b"))
                    (:mlist (NTree (make-node "inner")
                                   (map leaf-make (words "c d e f"))))
                    (map leaf-make (words "g h"))))))

(: right-promote :fun (m Edit) ((z Edit))
   :context((Monad m))
   (:case (:rpipe z context)
          ((:cons(NTC(myleft)(myparent)(myright))
                 (:cons(NTC(pleft)(pparent)(pright))
                       (grandparent-context)))
           (:let
            (: new-right :fun (:list Nnode)()
               (++ myright pright))
            (: new-left :fun Nnode()
               (NTree myparent (reverse myleft)))
            (return (NTZ (ntree z) (:mcons (NTC (:mcons new-left pleft) pparent new-right)grandparent-context)))
            ))
          :else (fail "right-promote did not have parent")
          ))

[
(a b (c d e f) g h)
(a b c d e (f) g h)
]
(: left-promote :fun (m Edit) ((z Edit))
   :context ((Monad m))
   (:case (:rpipe z context)
          ((:cons(NTC(myleft)(myparent)(myright))
                 (:cons(NTC(pleft)(pparent)(pright))
                       (grandparent-context)))
           (:let
            (: new-left :fun (:list Nnode)()
               (++ myleft pleft))
            (: new-right :fun Nnode()
               (NTree myparent myright))
            (return (NTZ (ntree z) (:mcons (NTC new-left pparent (:mcons new-right pright) )grandparent-context)))
            ))
          :else (fail "left-promote did not have parent")
))

(: sample :fun Edit ()
   (fromTree(list-make
                   (:cc
                    (map leaf-make (words "a b"))
                    (:mlist (list-make
                                   (map leaf-make (words "c d e f"))))
                    (map leaf-make (words "g h"))))))
(: two-to-connect :fun Edit ()
   (fromTree(list-make
             (:cc
              (map leaf-make (words "a b"))
              (:mlist (list-make
                       (map leaf-make (words "c d e f")))
                      (list-make
                       (map leaf-make (words "j j j j"))))
              (map leaf-make (words "g h"))))))

(: get-full-tree :fun Edit ((e Edit))
   (:case (mvUp e)
          (Nothing e)
          ((Just x) (get-full-tree x))))
[(: m :fun (:fn (Maybe p)((x p))) ((f(:fn p ((x p)))))
   (:rcompose f Just))]

(: safe-child :fun (m Edit) ((z Edit))
   :context((MonadPlus m))
   (:do
    (:rpipe z ntree isLeaf guard)
    (:rpipe z ntree getNode fst isNothing guard)
    (:rpipe z make-child-here return)))

   
   
(: safe-set :fun (m Edit) ((s String)(z Edit))
   :context((MonadPlus m))
   (:do
    (:rpipe z ntree isLeaf guard)
    (:rpipe z ntree getNode fst isNothing guard)
    (:rpipe z (set-val (make-node s)) return)
    ))

(: unset :fun (m Edit) ((z Edit))
   :context((MonadPlus m))
   (:do
    (:rpipe z ntree isLeaf guard)
    (:rpipe z (set-val placeholder) return)
    ))

(: no-children :fun Edit ((z Edit))
   (:field-edit z (ntree (mkTree (:rpipe z ntree getNode)(:mlist)))))
(: Rep-type :type-synonym (IO Nnode))
(: read-eval-print-loop :fun Rep-type ((z Edit))
   (:do
    [(:rpipe z get-full-tree ntree print-tree)]
    [(print z)]
    (putStr "$ ")
    (hFlush stdout)
    (:= l String getLine)
    (putStrLn (:cc "You said: "  (show l)))
    (:case (== l "exit")
           (True (:rpipe z get-full-tree ntree return))
           :else
           (:let
            (: go :fun Rep-type((f (:fn (Maybe Edit)((x Edit)))))
               (:case (f z)
                      (Nothing
                       (:do
                        (putStrLn "failed")
                        (read-eval-print-loop z)))
                      ((Just(j))
                       (read-eval-print-loop j))))
            (: no-change :fun Rep-type((action (IO :unit)))
               (:do
                action
                (read-eval-print-loop z)))
            (:case (words l)
                   ((:plist(:pstring"child")) (go safe-child))
                   ((:plist(:pstring"down"))(go mvDown))
                   ((:plist(:pstring"up"))(go mvUp))
                   ((:plist(:pstring"left"))(go mvLeft))
                   ((:plist(:pstring"right"))(go mvRight))
                   ((:plist(:pstring"set")(val))(go (safe-set val)))
                   ((:plist(:pstring"show"))(no-change (print z)))
                   ((:plist(:pstring"top"))(:rpipe z get-full-tree ntree print-tree no-change))
                   ((:plist(:pstring"aleft"))(go add-tree-left))
                   ((:plist(:pstring"aright"))(go add-tree-right))
                   ((:plist(:pstring"dleft"))(go dropTreeLeft))
                   ((:plist(:pstring"dright"))(go dropTreeRight))
                   ((:plist(:pstring"push"))(go (:rcompose push-down Just)))
                   ((:plist(:pstring"tright"))(go (:rcompose this-down-right Just)))
                   ((:plist(:pstring"tleft"))(go (:rcompose this-down-left Just)))
                   ((:plist(:pstring"pright"))(go right-promote))
                   ((:plist(:pstring"pleft"))(go left-promote))
                   ((:plist(:pstring"unset"))(go unset))
                   ((:plist(:pstring"noc"))(go (:rcompose no-children Just)))
                   :else
                   (no-change 
                    (putStrLn "bad command")
                    ))))))
[next unsolved: undo, readline]