1Lang
1Lang ist eine funktionale Präfixsprache wie LISP oder Scheme, jedoch ohne Klammern, was das Lesen etwas erschwert, wenn alle unnötigen Leerzeichen entfernt werden. Klammern können entfernt werden, da alle Funktionen und Operatoren eine bekannte Anzahl von Parametern verwenden.
Klammern sind erforderlich, um Funktionskörper und bedingte Konsequenzen sowie alternative Codeblöcke, die aus einer Liste von Anweisungen bestehen können, abzugrenzen.
In LISP könnte Factorial folgendermaßen definiert werden:
(defun fact (x) (if (< x 2) 1 (* x (fact (- x 1))) ) )
in 1Lang wäre dies
@Fx{ ? < x 2 {1} {* x F -x1} }
die reduziert werden kann
@Fx{?<x2{1}{*xF-x1}}
1Lang unterstützt derzeit keine Nebenwirkungen.
1Lang ist in Bash geschrieben, sodass es derzeit einige Bash-Einschränkungen wie den Integer-Bereich aufweist.
a-z are variables. Variable are either integers, strings, or lists.
NB: Listen sind nicht vollständig implementiert.
A-Z are functions
Ganzzahlen sind Bash-Ganzzahlen (bis zu -2 ^ 32 bis 2 ^ 31-1, denke ich). Negative Zahlen können nicht direkt verwendet werden. Um ein Negativ einzugeben, subtrahieren Sie es von Null. z.B. -5 würde als -0 5 eingegeben. Diese Einschränkung liegt daran, dass 1Lang in Arbeit ist und für diese Anwendung keine negativen Zahlen benötigt wurden. Ich überlege, ~ als unären negativen Operator zu verwenden, der die Eingabe von -5 als ~ 5 erlauben würde.
Leerraum ist erforderlich, um ganze Zahlen abzugrenzen. z.B. +2 3
: means assign eg. :c34 to assign 34 to c
+-*/% are binary integer operators eg. +12 34
&|^ are binary bit-wise operators
! is unary boolean not
~ is unary one's complement
? is a if-then-else function-like operator. eg. ?=x3{*xx}{0} is x=3 return x*x else 0
+ is also a binary string concatenation operator eg. +99" bottles"
* is also a string repetition operator eg. *5" hello" or *" hello"5
@ defines a function eg. @Fx{?<x1{1}{*xF-x1}}
Funktionsparameternamen können Aufrufervariablen überlasten. Alle innerhalb einer Funktion zugewiesenen Variablen sind lokal.
Drucken ist nicht erforderlich (obwohl dies nützlich sein könnte), da wie bei LISP jede Anweisung einen Wert zurückgibt und der zuletzt zurückgegebene Wert gedruckt wird.
eg. +2 3 prints 5
Ein unerwartetes Verhalten der Präfixnotation ohne Klammern besteht darin, dass die Verkettung von Zeichenfolgen tatsächlich einfach zu schreiben ist. Angenommen, Sie möchten verketten "a" " quick" " brown" " fox", könnte man schreiben:
+++"a"" quick"" brown"" fox"
Eine besser lesbare und weniger fehleranfällige Methode ist jedoch die folgende:
+"a"+" quick"+" brown"" fox" (Note missing + between last terms)
oder
+"a"+" quick"+" brown"+" fox"""
99 Flaschen Bier Code:
:b" of beer"
:w" on the wall"
:t"Take one down and pass it around, "
:s"Go to the store and buy some more, "
:c", "
:n".\n"
@Bx{?=x0{+"No more bottles"b}{+x+" bottle"+?=x1{""}{"s"}b}}
@Fx{?=x0{+B0+w+c+B0+n+s+B99+wn}{+Bx+w+c+Bx+n+t+B-x1+w+n+"\n"F-x1}}
F99
Funktion B liefert je nach x "No more bottles" oder "1 bottle" oder "bottles".
Funktion F gibt normale Verse oder letzte Verse zurück. Ein normaler Vers wird mit dem folgenden Vers verkettet, indem F rekursiv mit -x1 aufgerufen wird. Wenn x 0 ist, gibt F den letzten Vers zurück.
Dies erzeugt (für F5 bedeutet ab 5 Flaschen Bier ...):
> F5
5 bottles of beer on the wall, 5 bottles of beer.
Take one down and pass it around, 4 bottles of beer on the wall.
4 bottles of beer on the wall, 4 bottles of beer.
Take one down and pass it around, 3 bottles of beer on the wall.
3 bottles of beer on the wall, 3 bottles of beer.
Take one down and pass it around, 2 bottles of beer on the wall.
2 bottles of beer on the wall, 2 bottles of beer.
Take one down and pass it around, 1 bottle of beer on the wall.
1 bottle of beer on the wall, 1 bottle of beer.
Take one down and pass it around, No more bottles of beer on the wall.
No more bottles of beer on the wall, No more bottles of beer.
Go to the store and buy some more, 99 bottles of beer on the wall.
<End>
1Lang-Interpreter (in Bash geschrieben) in weniger als 500 Zeilen.
#!/bin/bash
LC_ALL=C # else [a-z] and [A-Z] misbehave
# functions return result on stdout
# functions have an environment
# Requirements:
# * minimise size
# -> eliminate delimiters
# -> single letter variables and functions
# -> no precidence
# -> no overloading
# *
# string "text with \characters as per printf"
# numbers 123
# functions F3
# Built-ins +-*/%^ &|~ ! etc.
# assignment :v12 :v"string"
log(){ local m="${l:p}" m="${m//[$NL]/\n}" v="${FUNCNAME[1]}"; echo "$v: l=[${l//[$NL]/\n}] ch=[${ch/[$NL]/\n}] next=[$m]" >&2; }
logr(){ local m="${l:p}" m="${m//[$NL]/\n}" v="${FUNCNAME[1]}"; echo "$v: l=[${l//[$NL]/\n}] ch=[${ch/[$NL]/\n}] next=[$m] ret=[${ret//[$NL]/\n}]" >&2; }
logv(){ local v="${FUNCNAME[1]}"; echo "$v: ret=[${ret//[$NL]/\n}]" >&2; }
logm(){ local m="$1" v="${FUNCNAME[1]}"; echo "$v: ${m//[$NL]/\n} in [${read//[$NL]/\n}]." >&2; }
msg(){ echo -En "$1" >&2; }
msn(){ echo -E "$1" >&2; }
# ==========
# Line layer
# ==========
declare l
readline(){ read -rp"1lang> " l; }
#==================
# Environment Layer
#==================
declare -A v t # variables and variable type
declare ret typ # all bash function return these values
# assign = : var expression
assign(){
local var
readch
var && var=$ret || { logm "ERROR: variable name expected" ; return 1; }
exp || { logm "ERROR: value or expression expected"; return 1; }
v["$var"]="$ret"
t["$var"]="$typ"
}
# get variable value
get(){
local var
var && var=$ret || { logm "ERROR: variable name expected"; return 1; }
ret=${v["$var"]}
typ=${t["$var"]}
}
declare -A func fpar
declare -iA fnum # functions
# define = @ F param* { body }
define(){
local fn par body
readch
fn && fn=$ret || { logm "ERROR: function name expected"; return 1; }
fpar[$fn]= # zero parameters
fnum[$fn]= # zero parameter counter
while var;do # read parameters
fpar[$fn]+=$ret
fnum[$fn]+=1 # cound parameters
done
# get body but remove block delimiters
skip "{" "}" && body="${ret:1: -1}" || { logm "ERROR: function body expected"; return 1; }
readch # skip }
func[$fn]="$body" # store function body
ret="@$fn${fpar[$fn]}{$body}"
typ='f'
}
apply(){
local fn=$ch n c s; local -i N q
readch
N=${fnum[$fn]} # number of parameters
n=${fpar[$fn]} # parameters
s=${func[$fn]} # function body
c=
for((q=0; q<N; q++)){
exp || { logm "ERROR: value expected"; return 1; }
c+="v[${n:q:1}]=\"$ret\"; " # add value to script
c+="t[${n:q:1}]=\"$typ\"; " # add type to script
}
# parse function in a subshell and echo result and type back
# subshell means all variable changes in function are local
c+="parse <<<'$s'; echo -E \"\$typ\$ret\"" # combine type and value
ret=
typ=
ret="$( eval "$c" )" || { logm "ERROR: function application failed"; return 1; }
typ="${ret::1}" # extract type
ret="${ret:1}" # get actual return value
}
# bash oddities:
# [[ 1 -eq 1 ]] -> 0 or success
# [[ 1 -eq 2 ]] -> 1 or failed
# x=1\<2 -> a=1 (true)
# x=1\<1 -> a=0 (false)
# ((1==1)) -> 0 or success
# ((1==2)) -> 1 or failed
# declare -i a; a=1==1 -> a=1 (true)
# declare -i a; a=1==2 -> a=0 (false)
binary(){
local -i iret; local op=$ch a b at bt
readch
exp && { a="$ret"; at=$typ; } || { logm "ERROR: initial expression expected"; return 1; }
exp && { b="$ret"; bt=$typ; } || { logm "ERROR: second expression expected" ; return 1; }
ret=
typ=
case "$at$bt" in
nn) # num op num
case "$op" in
[\*]) iret=a*b;;
[\^]) iret=a**b;;
[\+]) iret=a+b;;
[\-]) iret=a-b;;
[\/]) [[ b -ne 0 ]] && { iret=a/b; } || { logm "ERROR: division by 0" ; return 1; };;
[\%]) [[ b -ne 0 ]] && { iret=a%b; } || { logm "ERROR: modulo division by 0"; return 1; };;
[\&]) iret=a\&b;;
[\|]) iret=a\|b;;
[\#]) iret=a\^b;;
[\=]) iret=a==b;;
[\<]) iret=a\<b;;
[\>]) iret=a\>b;;
esac
ret=$iret
typ='n';; # result is always a decimal number
ss) # string op string
case "$op" in
# [\*]) arith=a*b;; # combine?
# [\#]) arith=${}a**b; type='s';;
[\+]) ret="$a$b"; typ='s';; # concatenate
[\-]) ret="${a//$b}"; typ='s';; # remove substrings
[\=]) [[ $a = $b ]]; ret=$?; typ='n';;
[\<]) [[ $a < $b ]]; ret=$?; typ='n';;
[\>]) [[ $a > $b ]]; ret=$?; typ='n';;
esac;;
ns) # num op string =3"hello" ="hello"3 ="3"3 =3"4"
case "$op" in
[\+]) ret="$a$b"; typ='s';; # concatenate
[\*]) ret=$(eval echo \"\${b[0]\"{1..$a}\"}\"); typ='s';; # repeat b a times
[\=]) ((${#b}==a)); ret=$?; typ='n';; # length b is a
# [\<]) [[ $a < $b ]]; arith=$?; typ='n';;
# [\>]) [[ $a > $b ]]; arith=$?; typ='n';;
esac;;
sn) # string op num *"hello"3 ="3"3 =3"4"
case "$op" in
[\+]) ret="$a$b"; typ='s';; # concatenate
[\*]) ret=$(eval echo \"\${a[0]\"{1..$b}\"}\"); typ='s';; # repeat a b times
[\=]) ((${#a}==b)); ret=$?; typ='n';; # length a is b
# [\<]) [[ $a < $b ]]; arith=$?; typ='n';;
# [\>]) [[ $a > $b ]]; arith=$?; typ='n';;
esac;;
*) logm "ERROR: undefined operation [$op] for [$a] [$at] and [$b] [$bt]"; return 1;
esac
return 0
}
# FIXME: string ops?
unary(){
local -i iret; local op="$ch"
readch
exp || { logm "ERROR: expression expected"; return 1; }
case "$op" in
[\!]) iret=\!ret;;
[\~]) iret=\~ret;;
esac
ret=$iret
typ='n' # result is always a decimal number
}
#==============
# Control Layer
#==============
# iff = ? boolean { consequence block } { alternative block }
# ?<1 2{+4 5}{+1 2}
iff(){
local -i c; local iff ift
readch
exp && c=$ret || { logm "ERROR: value or expression expected"; return 1; }
[[ c -eq 1 ]] && { # true so do consequence
ws
block && { iff="$ret"; ift="$typ"; } || { logm "ERROR: consequence block error"; return 1; }
ws
skip "{" "}" || { logm "ERROR: alternate block expected"; return 1; }
ret="$iff"
typ="$ift"
} || {
ws
skip "{" "}" || { logm "ERROR: consequence block expected"; return 1; }
ws
block || { logm "ERROR: alternate block error"; return 1; }
}
}
#==============
# Symbols Layer
#==============
# fn = [A-Z]
fn(){
# FIXME: make evalu?
[[ $ch = [A-Z] ]] || return 1
ret=$ch
typ='c'
readch
}
# var = [a-z]
var(){
# FIXME: make evalu?
[[ $ch = [a-z] ]] || return 1
ret=$ch
typ='c'
readch
}
# list = ( token* )
# FIXME: not finished and no operators support lists
list(){
local list=$ch prev
readch
while [[ $ch != ')' ]];do
exp || { logm "ERROR: expression expected"; return 1; }
case $typ in
[n]) list+=" $ret";;
[s]) list+="$ret";;
[l]) list+="$ret";;
esac
ws
done
ret="$list$ch"
readch
typ='l'
return 0
}
#============
# Token Layer
#============
# char = ' echoch
#echoch = \ {special echo escape character} | {char}
char(){
readch
case "$ch" in
[\\]) escch || { logm "ERROR: escape character expected"; return 1; };;
?) ret="$ch"; readch
esac
typ='c'
}
# escaped characters are a pain
# use read with -r to read in verbatim - no escaping
# use echo -E to write out verbatim (except \\ may be processed)
declare escchS
declare ECHO='abefnrtv'
# double \\ for a \
escch(){
local ESC="$ch"
readch # skip \
case "$ch" in
[$ECHO]) printf -v ret "%b" "$ESC$ch"; readch;;
[\\]) ret="\\"; readch;;
[\"]) ret="\""; readch;;
[0-7]) onum && { printf -v ret "%b" "$ESC$ret" ; } || { logm "ERROR: octal number expected"; return 1; };;
[xU]) readch; hnum && { printf -v ret "%b" "${ESC}x$ret"; } || { logm "ERROR: hex number expected" ; return 1; };;
?) ret="$ch"
[[ $escchS ]] || {
tidyReadCh
logm "WARNING: only octal, hex, unicode, and [$ECHO\\\"] characters need to be escaped with '$ESC'"
logm "WARNING: [$ch] in [$l] does not need to be escaped"
escchS="OFF"
}
readch
esac
typ='c'
}
# num = digit digit*
# onum = odigit odigit*
# onum = hdigit hdigit*
num(){ local num; num=$ch; readch; while digit;do num+=$ret; done; ret=$num; typ='n'; }
onum(){ local num; num=$ch; readch; while odigit;do num+=$ret; done; ret=$num; typ='n'; }
hnum(){ local num; num=$ch; readch; while hdigit;do num+=$ret; done; ret=$num; typ='n'; }
# digit = [0-9]
# odigit = [0-7]
# odigit = [0-9a-fA-F]
digit(){ [[ $ch == [0-9] ]] || { ret=-1; return 1; }; ret=$ch; typ='s'; readch; }
odigit(){ [[ $ch == [0-7] ]] || { ret=-1; return 1; }; ret=$ch; typ='s'; readch; }
hdigit(){ [[ $ch == [0-9a-fA-F] ]] || { ret=-1; return 1; }; ret=$ch; typ='s'; readch; }
# string = " char* "
# char = escch | {any character}
string(){
skip "\"" "\"" || { logm "ERROR: quoted string expected"; return 1; }
ret="${ret:1: -1}"
typ='s'
return 0
}
# ==========
# Char layer
# ==========
declare ch read
declare -i p L COUNT
readch(){
if [[ p -eq L ]]; then # need more code
readline || { ch=; p=L=0; l="EOF"; return 1; }
l+=$NL;
p=0
L=${#l}
fi
# FIXME: remove once eady - prevents bash consuming all memory
COUNT+=1
((COUNT>100000)) && { logm "FAILSAFE: too many charcters read"; return 1; }
ch="${l:p:1}"
read+="$ch"
p+=1 # queue next character
}
# skip = SS content* ES
# content = ch | escch | skip(SS ES)
# string = " ch* "
skip(){
local s="$1" e="$2" b="$ch"
typ='z' # code fragment
[[ $ch != $s ]] && return # nothing to skip
readch
while [[ -n $ch ]];do
case "$ch" in
$e) b+="$e" ; readch; ret="$b"; return 0;;
$s) skip "$s" "$e"; b+="$ret";;
[\\]) escch ; b+="$ret";;
[\"]) skip "\"" "\""; b+="$ret";;
?) b+="$ch" ; readch
esac
done
ret="$b"
logm "ERROR: unexpected EOF"
exit 1
}
# FIXME: still required?
shopt -s extglob
shopt -u nocasematch
declare NL; printf -v NL "%b" "\n" # echo $NL | hexdump -C
declare WS; printf -v WS "%b" " \n\t\r" # define whitespace
# FIXME: should it set ret and typ?
ws(){ while [[ $ch == [$WS] ]];do readch; done; } # skip any WS
#=====
# eval
#=====
# exp = [0-9] num
# | " string "
# | : assignment
# | @ function definition
# | [-+*/%^] binary operation
# | [&|#<>=] boolean operation
# | [!~] unary operation
# | [A-Z] function application
# | [a-z] variable
# | ? if expression
# | { expression* } block expression
# | ( expression* ) list of expressions
# spare prefix characters [ '$[]_\;, ]
# [v head of list
# ]v tail of list
exp(){
ws
case "$ch" in
[0-9]) num || { logm "ERROR: number expected" ; return 1; };;
# [\']) char || { logm "ERROR: char expected" ; return 1; };;
[\"]) string || { logm "ERROR: string expected" ; return 1; };;
[\:]) assign || { logm "ERROR: assignment expected" ; return 1; };;
[\@]) define || { logm "ERROR: function definition expected" ; return 1; };;
[-+*/%^]) binary || { logm "ERROR: binary expression expected" ; return 1; };;
[\&\|#\<\>=]) binary || { logm "ERROR: binary expression expected" ; return 1; };;
[\!~]) unary || { logm "ERROR: unary expression expected" ; return 1; };;
[A-Z]) apply || { logm "ERROR: function failed" ; return 1; };;
[a-z]) get || { logm "ERROR: variable name expected" ; return 1; };;
[\?]) iff || { logm "ERROR: boolean expression expected" ; return 1; };;
[\{]) block || { logm "ERROR: code block expected" ; return 1; };;
[\(]) list || { logm "ERROR: list expected" ; return 1; };;
'') ret=; logm "ERROR: unexpected EOF" ; return 1;;
*) ret="$ch" ; return 1;;
esac
return 0
}
# block = { code }
block(){
readch # skip {
while [[ $ch != "}" ]];do
exp || {
tidyReadCh
logm "WARNING: ignoring previous error or unknown symbol [$ch]"
[[ errors+=1 -gt 5 ]] && { logm "ERROR: exiting due to too many warnings"; exit 1; }
}
ws
done
readch # skip }
return 0
}
#=====
# repl
#=====
# pass an expression on stdin- not used withing same ebvironment - called by apply
parse(){
p=L # force readline
ch=
read=
readch # clears ch
while [[ $ch && $ch != '.' ]];do
exp || { logm "ERROR: expression expected"; return 1; }
read=$ch
ws
done
# last expression is returned as result
}
tidyReadCh(){
tidyRead
ch="${ch//[$NL]/\n}"
}
tidyRead(){
read="${read//[$NL]}"
}
# repl = eval* EOF
# eval = evalu | readch
repl(){
readch
while [[ $ch && $ch != '.' ]];do
exp && {
tidyRead
msn "> $read" # echo line except for WS
# echo -E "$ret [$typ]"
echo -E "$ret"
read=$ch
} || {
tidyReadCh
msn "> $read"
logm "WARNING: ignoring previous error or unknown symbol [$ch]"
read=
readch
[[ errors+=1 -gt 5 ]] && { logm "ERROR: exiting due to too many warnings"; exit 1; }
}
ws
done
msn "<End>"
}
#=====
# test
#=====
# FIXME: negative numbers
msn "1Lang"
repl <<<'
:b" of beer"
:w" on the wall"
:t"Take one down and pass it around, "
:s"Go to the store and buy some more, "
:c", "
:n".\n"
@Bx{?=x0{+"No more bottles"b}{+x+" bottle"+?=x1{""}{"s"}b}}
@Fx{?=x0{+B0+w+c+B0+n+s+B99+wn}{+Bx+w+c+Bx+n+t+B-x1+w+n+"\n"F-x1}}
F99
'