if 0 {
This is Pils (the name is an anagram of Lisp). Take it as a language design study derived from Tcl. Heavy differences to classic Lisp, but inherits the ease of just taking () instead of {[[]]}!

Note that it is far from complete, even proc is missing, but you can try (list a b) or so.
    
Usage with arguments:

    rep (list a b) => (a b)
    rep {(list a "b c" d)} => (a "b c" d)
    
Usage without arguments leads to the read-eval-print loop:
    
    rep
    Pils> _
    
To leave the rep, press <Enter> without input.
    
Feel free to take it, to use it, to change it, or to re-implement it in C. I would be happy!
 }
 
 interp alias {} ? {} set errorInfo
 proc -- args {}
 -- {
    If you need multi-line comments, use -- instead of #.
 
    If you want to comment out a proc definition, use it too.
 
    If you want to document, use this:
    doc {
        ... this is what I intended ...
    }
    The proc doc is some kind of "poor man's literate programming".
 }
 proc echo args {puts $args}
 proc vertical args {join [uplevel $args] \n}
 proc sourceCode p {
    list\
 	[namespace origin proc]\
 	[namespace origin $p]\
 	[info args $p]\
 	[info body $p]
 }
 proc doc args {
    foreach arg $args {
        append ::doc \n [string trim $arg \n] \n
    }
 }
 
 doc {
    This is Pils. The name is an anagram of Lisp.
 
    Pils is a tiny lisp, made as Tcl-ish as possible.
    List are not cons'd such that no element nil is necessary.
    Instead, the empty list () is a "true" list.
    But it is treated as boolean false.
 
    While Tcl has exactly 1 data type,
    Pils has exactly 2:
    (a) the atom,
    (b) the list.
    There are even no symbols as every atom can serve as such!
 
    By the way, in Germany Pils is pronounced "beer"
    except in Cologne where Koelsch has this pronounciation.
    German pronounciation is not a science but an art.
 }
 
 doc {
    The namespace Pils contains the lisp procedures.
    The namespace Pils::private contains helper procedures.
 }
 
 namespace eval Pils {
    namespace eval private {
        namespace export *
    }
 }
 
 doc {
    The procedures map, not, let, and shift
    do just what the name suggests:
 }
 
 proc ::Pils::private::map {f l} {
    set result {}
    foreach e $l {
 	lappend result [uplevel [list $f $e]]
    }
    set result
 }
 proc ::Pils::private::not bool {expr {$bool ? false : true}}
 proc ::Pils::private::let args {uplevel foreach $args break}
 proc ::Pils::private::shift {stackVar} {
    upvar $stackVar stack
    set result [lindex $stack 0]
    set stack [lrange $stack 1 end]
    set result
 }
 
 doc [sourceCode ::Pils::private::map]\
    [sourceCode ::Pils::private::not]\
    [sourceCode ::Pils::private::let]\
    [sourceCode ::Pils::private::shift]
 
 doc {
    The procedure tokenise takes the source text
    and returns a stream of type val type val
    where type is either data or control
    and val is either an atom or ( or ) or such.
 
    Processing of special chars -- immediately: 
 
    ; #	line comment -- rest of line is ignored
    ""	double-quotes group chars to atoms
    \	prevents from special handling: \; \" \( \) \$ \'
 
    Recognising more special chars:
 
    ()	parens, intended for grouping to lists
    $	dollar sign, intended as shortcut for (set ...)
    '	quote, intended as shortcut for (quote ...)
 }
 
 proc ::Pils::private::tokenise text {
    set verbatim no
    set quoteMode no
    set commentMode no
    set tokens {}
    set token ""
    foreach c [split $text ""] {
        if {$commentMode} then {
 	    if {$c eq "\n"} then {
 		set commentMode no
 	    }
 	} elseif {$verbatim} then {
            append token $c
            set verbatim no
        } else {
            set verbatim no
            switch -- $c {
                \\ {
                    set verbatim yes
                }
 		; - \# {
 		    if {$quoteMode} then {
 			append token $c
 		    } else {
 			if {$token ne ""} then {
 			    lappend tokens data $token
 			    set token ""
 			}
 			set commentMode yes
 		    }
 		}
                \" {
 		    if {$quoteMode} then {
 			# the only way to create an empty token 
                        lappend tokens data $token
                        set token ""
 		    } elseif {$token ne ""} then {
 			lappend tokens data $token
 			set token ""
 		    }
                    set quoteMode [not $quoteMode]
                }
                ( - ) - " " - \n - \t - ' - $ {
                    if {$quoteMode} then {
                        append token $c
                    } else {
                        if {$token ne ""} then {
                            lappend tokens data $token
                            set token ""
                        }
                        if {[string is graph $c]} then {
                            lappend tokens control $c
                        }
                    }
                }
                default {
                    append token $c
                }
            }
        }
    }
    if {$token ne ""} then {
        lappend tokens data $token
    }
    set tokens
 }
 
 doc {
    The procedure tokensVar2List takes the name of a var containing tokens,
    and builds internal lisp data.
    For practical reasons (recursion on lists),
    the variable is changed destructively.
    Returns list of data where
    each date is an atom {1 ...} or a list {0 ...}
 
    The control tokens $ and ' are processed with processCtrlTokensVar.
 
    The procedure parseList collects the tokens to an internal variable
    and calls the procedure tokensVar2List to gain the data.
 
    (This is the only proper use of destructive functions imho.
     To be honest, I do not like destructive functions.)
 }
 
 proc ::Pils::private::processCtrlTokensVar {tokensVar levelVar key} {
    upvar $tokensVar tokens
    upvar $levelVar level
    if {[llength $tokens] == 0} then {
 	return -code error [list quote without value]
    } else {
 	list 0 [concat\
 		    [list [list  1 $key]]\
 		    [tokensVar2List tokens level 1]]
    }
 }
 
 proc ::Pils::private::tokensVar2List {tokensVar levelVar {count -1}} {
    upvar $tokensVar tokens
    upvar $levelVar level
    # attention -- destuctive!
    set result {}
    while {[llength $tokens] && $count} {
 	set type [shift tokens]
        set token [shift tokens]
 	if {$type eq "data"} then {
 	    lappend result [list 1 $token]
 	} else {
 	    switch -- $token {
 		\' {
 		    lappend result [processCtrlTokensVar tokens level quote]
 		}
 		\$ {
 		    lappend result [processCtrlTokensVar tokens level set]
 		}
 		\( {
 		    incr level
 		    lappend result [list 0 [tokensVar2List tokens level]]
 		}
 		\) {
 		    incr level -1
 		    break
 		}
 	    }
 	}
 	incr count -1
    }
    set result
 }
 
 proc ::Pils::private::parseList text {
    set tokens [tokenise $text]
    set level 0
    set result [tokensVar2List tokens level]
    if {$level > 0} then {
 	return -code error [list unmatched opening paren in expression $text]
    } elseif {$level < 0} then {
 	return -code error [list unmatched closing paren in expression $text]
    }
    set result
 }
 
 doc {
    The procedure unParse returns the human readable source
    of a single lisp date, e.g. {0 {{1 a} {1 apple}}} => (a apple)
 }    
 
 proc ::Pils::private::unParse data {
    let {isAtom val} $data
    if {$isAtom} then {
 	regsub -all (^\{)|(\}$) [list [string map {
 	    \\ \\\\ \' \\\' \( \\\( \) \\\) \" \\\" \$ \\\$
 	} $val]] \"
    } elseif {[llength $val] == 2
 	      &&
 	      [lindex $val 0 0] == 1
 	      &&
 	      [regexp ^(set|quote)$ [lindex $val 0 1]]} then {
 	array set specialChar {
 	    quote \'
 	    set \$
 	}
 	set result $specialChar([lindex $val 0 1])
 	append result [unParse [lindex $val 1]]
    } else {
        set result ([join [map unParse $val]])
    }
 }
 
 doc {
    The procedure unParseList returns the human readable source
    of a Tcl list of lisp data.
    The procedures list? and atom? return true/false depending on type.
    The procedure expr2tcl converts a Lisp list to a Tcl list.
    The procedure expr2cmd converts an expression to a proc calling string.
 }
 
 proc ::Pils::private::unParseList data {
    join [map unParse $data]
 }
 
 proc ::Pils::private::list? datum {
    expr {[lindex $datum 0] == 0 ? true : false}
 }
 
 proc ::Pils::private::atom? datum {
    expr {[lindex $datum 0] == 1 ? true : false}
 }
 
 proc ::Pils::private::true? datum {
    if {[lindex $datum 0]} then {
 	expr {[string is false -strict [lindex $datum 1]] ? false : true}
    } else {
 	expr {[llength [lindex $datum 1]] ? true : false}
    }
 }
 
 proc ::Pils::private::expr2tcl x {
    if {[atom? $x]} then {
 	lindex $x 1
    } else {
 	map expr2tcl [lindex $x 1]
    }
 }
 
 proc ::Pils::private::expr2varName x {
    if {[atom? $x]} then {
 	expr2tcl $x
    } else {
 	set l [lindex $x 1]
 	if {[llength $l] != 2} then {
 	    return -code error\
 		[list array name needs list with 2 names\
 		     but received [unParse $x]]
 	} else {
 	    set result [expr2tcl [lindex $l 0]]
 	    append result ( [expr2tcl [lindex $l 1]] )
 	}
    }
 }
 
 proc ::Pils::private::expr2cmd x {
    let {isAtom value} $x
    if {$isAtom} then {
 	set result "quote [list $x]"
    } elseif {[llength $value]} then {
 	# x is a non-empty list
 	set first [lindex $value 0]
 	set name [lindex $first 1]
 	switch $name {
 	    quote - quasiquote -
 	    if - while {
 		set result $name
 		eval lappend result [lrange $value 1 end]
 	    }
 	    default {
 		if {[info command ::Pils::$name] ne ""} then {
 		    set result $name
 		} else {
 		    set result [list tcl $first]
 		}
 		foreach el [lrange $value 1 end] {
 		    if {[atom? $el]} then {
 			append result " " [list $el]
 		    } else {
 			append result " \[" [expr2cmd $el] "\]"
 		    }
 		}
 		set result
 	    }
 	}
    } else {
 	# x is ()
 	list quote [list 0 {}]
    }
 }
 
 proc ::Pils::private::tcl args {
    eval [list uplevel \#0 [list namespace inscope :: $args]]
 }
 
 proc ::Pils::private::pils l {
    set rawData [parseList $l]
    set cmdData [map expr2cmd $rawData]
    set result {}
    foreach cd $cmdData {
 	lappend result [namespace inscope ::Pils $cd]
    }
    join [map unParse $result] \n
 }
 
 proc ::Pils::private::repLine {} {
    puts -nonewline {Pils> }
    flush stdout
    pils [gets stdin]
 }
 
  #             ####
 ##      ##### ####
 ###   ####### #### 
 ###  ###     #### ###  
 ### ###     ####   ###   End of namespace ::Pils::private
 ### ###    ####    ###   Starting overloading procs in namespace ::Pils
 ### ###   ####     ###   *Danger* -- use Tcl commands with leading :: only!
 ###  ### ####     ###
 ###     #### #######
 ##     #### #####
 #     ####
 
 proc ::Pils::quote x {
    ::set x
 }
 
 proc ::Pils::if {cond thenClause {elseClause {}}} {
    ::set ifClause ::if
    ::set clause1 [::list private::true? $cond]
    ::lappend ifClause \[$clause1\] then [private::expr2cmd $thenClause]
    ::if {$elseClause ne ""} then {
 	::lappend ifClause else [private::expr2cmd $elseClause]
    }
    ::uplevel $ifClause
 }
 
 proc ::Pils::while {cond thenClause} {
    ::set whileClause ::while
    ::set clause1 [::list private::true? $cond]
    ::lappend whileClause \[$clause1\] [private::expr2cmd $thenClause]
    ::uplevel $whileClause
 }
 
 proc ::Pils::eval l {
    ::eval [private::expr2cmd $l]
 }
 
 proc ::Pils::list args {::list 0 $args}
 
 proc ::Pils::lindex {l args} {
    ::set indices {}
    ::foreach arg $args {
 	::lappend indices 1 [::lindex $arg 1]
    }
    ::eval [::list ::lindex $l] $indices
 }
 
 doc {
    In Pils, vars and arrays are handled as follows:
    {Tcl: set a apple}		{Pils -- (set a apple)}
    {Tcl: set fruit(a) apple}	{Pils -- (set '(fruit a) apple)}
    {Tcl: $fruit(a)}		{Pils -- $'(fruit a)}
    {Tcl: $fruit(a)}		{Pils -- $(list fruit a)}
 }
 
 proc ::Pils::set {varName args} {
    ::if {[::lindex $varName 0]} then {
 	::uplevel [::list ::set [::lindex $varName 1]] $args
    } else {
 	::set arr [::lindex $varName 1 0 1]
 	::set key [::lindex $varName 1 1 1]
 	::uplevel [::list ::set ${arr}($key)] $args
    }
 }
 
 
 
 proc ::Pils::lset {varName args} {
    ::upvar [private::expr2varName $varName] var
    ::set indices {}
    ::foreach arg [::lrange $args 0 end-1] {
 	::lappend indices 1 [::lindex $arg 1]
    }
    ::eval [::list ::lset var] $indices [::lrange $args end end]
 }
 
 proc ::Pils::llength l {
    ::list 1 [::llength [::lindex $l 1]]
 }
 
 proc ::Pils::lrange {l from to} {
    ::list 0 [::lrange [::lindex $l 1] [::lindex $from 1] [::lindex $to 1]]
 }
 
 proc ::Pils::lsearch {l e} {
    ::list 1 [::lsearch [::lindex $l 1] $e]
 }
 
 proc ::Pils::lappend {varName args} {
    ::upvar [private::expr2varName $varName] var
    ::set l [::lindex $var end]
    ::eval ::lappend l $args
    ::lset var end $l
    ::set var
 }
 
 proc ::Pils::split {strObj {sepObj {1 " "}}} {
    ::set str [private::expr2tcl $strObj]
    ::set sep [private::expr2tcl $sepObj]
    ::set l {}
    ::foreach el [::split $str $sep] {
 	::lappend l [::list 1 $el]
    }
    ::list 0 $l
 }
 
 proc ::Pils::tcl args {
    ::list 1\
 	[::eval [::list private::tcl] [private::map private::expr2tcl $args]]
 }
 
 namespace import -force ::Pils::private::*
 
 proc rep args {
    if {$args ne ""} then {
 	if {[llength $args] == 1} then {
 	    set args [lindex $args 0]
 	}
 	uplevel [list ::Pils::private::pils $args]
    } else {
 	while true {
 	    set l [uplevel \#0 [list ::Pils::private::repLine]]
 	    if {$l ne ""} then {
 		puts $l
 	    } else {
 		break
 	    }
 	}
    }
 }
 
 rep