I don't know who the hell the in Symta guy is or why he's hiding the documentation these days, but here's an old Symta version that still has a lot of relevant documentation and example code.
I haven't tried it out yet, because I'm too lazy to install the required emacs packages. Maybe someone should look into it? I'll post some of the included files here, for the lazy.
First of all, make sure followin packages are present:
cffi, babel, trivial-shell and trivial-garbage
Here is how I myself run Symta:
- emacs
- Alt-X slime
- (require :symta)
- ($eval "read|eval|say|loop")
- To exit just Ctrl-C Ctrl-B
Quick Reference
------------------
Note: functions don't change their arguments
Case matters: variable names must start with uppercase letter
function names must start with lowercase letter
------------------
"Hello, World" // string
say "Hello, World" // prints "Hello World" on screen
'say // unevaluated symbol
[1 2 3] // list of 1 2 3
[2+3 2-3 2*3 2/3 ~3] // usual sum, subtraction, product, quotient and negation
[A==B A<B A>B A<=B A>=B] // comparisons
[1 @[2 3] 4 @[5 6]] // list splicing
#(1 $@[] 4 $@[5 6]) // quasiquoted version
[A=123 B=456] // associative list of sorted pairs (associative map)
Map.A // returns value associated with key "A" (shorthand for Map."A")
Map.(A) // same, but A is variable.
L,N // element N-th element of list `L`. If `N` is negative, then from end
Condition |> then // if/then from
Condition |> Then :: Else // if/then/else form
[20++(rand 10)] // list of 20 times random values
A<B |> A :: B // returns smalles value of A and B
sort !List // sorts `List`
sort !List // sorts `List` and saves back value into it
[10%3 10%%3] // remainder and truncating devision
fold ?+?? [1..50] // sums numbers from 1 to 100
map ?^2 [1..50] // squares all numbers in list
fold {A B -> A+B} [1..50] // same as fold ?+?? [1..50], but with explicit body
{1->1; N->N*(r N-1)} // factorial: `r` is default name for current lambda
do A B C // evaluates A, B, and C, returns C
do `+` // treats operator `+` as normal symbol
`'` A+B // quoted expression
f A B -> A+B // definition of function `f`, that adds its arguments
f A B=3 -> A+B // same but `B` is keyword; invoked like "f 2 B=7" or "f 2"
V -> 123 // global variable definition
A:123 // variable binding
A:1 B:2 A+B // declares local variables, then adds them
[(Y:(X:2+3)+4)+5 X Y] // more advanced example of local variables
A=:123 // changes value of previously declared variable
#(&A &B &A &C) // with auto-gensyms
1 | `+` 2 | `*` 4 | say // conveyor
[1..10] | ['start @? 'end] // another conveyor
[\a..\z] | {[_ @Middle _]->Middle} // pattern matching
all od? Xs; any odd? Xs // every, some from CL
X,f // shorthand for (f X)
/* Multi
Line
Comment */
// `f` calls `g` with its argument, binds value returned by
// `g` to `X` and returns `X`, if value returned by g is true
f X:!g -> X
// Example:
while stream,{x:!readLine->x,writeLine}
More Examples
------------------------
prime? N -> all N%?!=0 [2..N/2]
length [X@Xs] -> 1+Xs,length
flatten [@Xs] -> mapc flatten Xs; X->[X]
foldr f [X@Xs] -> foldr f Xs | f X
sign neg? -> ~1
; 0 -> 0
;pos? -> 1
; X -> error "sign: parameter $X is unsupported"
[1..10],{[_ X @Xs]->X+Xs,r} // sum even numbers
ordered? [A B @Xs] -> A<=B && ordered [B@Xs]; [_]->y
_all P [N++P] ->
_any P [@_ P @_] ->
_keep P [@_ X:P @Xs] -> [X @(keep P Xs)]
_strip P [@S P @E]->[@S @(r P E)]; _ X->X
reverse [X@Xs] -> [@Xs,rev X]
subseq From Size Str -> drop From Str | take Size
subseq From Size [From++_ Xs:_:Size++_ @_] -> Xs
pal []; [_]; [X @Xs X]->Xs,pal // Palindrome
fib N -> fold {[a b] _->[b a+b]} [[0 1] 1..N] | ?,0 // fibonacci number
"/fs/home/user/names.txt"|flines|sort // sort lines in names.txt
//tableJoin A B by=?,0 ->
// fold {R X->(T:X,by keep ?,by==T B) | map [X ?] | conc R} [[]@A]
// Take initial elements for which `p` is true
takeInit P [@Xs @(nb P)] -> Xs
//insert `sep` between elements of a list `l`
//Usage: infix '+ '(a b c)
//Example: map ?,asInt,asHex "LISP" | infix " " | fold sconc
//TODO: add flag to create "'(+ A (+ B C))" like lists
infix Sep L -> fold {Xs X -> [@Xs Sep X]} [(take 1 L) @L,ltl]
// break list into piles of `n` items
grp N [@Xs] -> [(take N Xs) @(drop N Xs | grp N)]
/* Example1: unfold {1->n; X->[X-1 1]} 7
Example2: qsort Xs -> Xs |
unfold {[X] -> X
;[X@Xs] -> [(keep ?<X Xs) [X] (keep ?>X Xs)]} */
unfold f O -> f O | {[]->[O]; Xs -> mapc (unfold f ?) Xs}
// counts the number of ones in the bit representation of an integer
// use it to calculate size of bitmasks
bitCount X -> cl logcount X
// bit-length of an integer: 2^(log 2 ? | ceil)
bitLen X -> cl `integer-length` X
// inverts `bits` bits in `value` (bitwise not)
inv Bits Value -> cl logxor (ash 1 Bits)-1 Value
exp X -> cl exp X
log Base X -> cl log X Base
sin X -> cl sin X
cos X -> cl cos X
tan X -> cl tan X
asin X -> cl asin X
acos X -> cl acos X
atan X -> cl atan X
sum S -> fold `+` [0@S]
prod S -> fold `*` [1@S]
avg Xs -> Xs,sum/Xs,len
abs X -> num? X |> cl abs X :: sqrt X*X
norm V -> V/V,abs
transpose V -> N:0 [V,lhd,len++(map (do I:N !N+1 ?,I) V)]
rand X:y? -> num? X |> cl random X :: cl ind X (random (len X))
randRng S E -> (abs E+1-S),rand+S
// convert list to set (an ordered list that doesn't have duplicated elements)
uniq L -> L,sort,{[@A X X @B]->[@A @[X @B],r]; E->E}
// set operations
union A B -> A,{[X@Xs]-> fnd X B |> Xs,r :: [x@Xs,r]; _->B}
isect A B -> A,{[X@Xs]-> fnd X B |> [X@Xs,r] :: Xs,r}
diff A B -> union (strip (fnd ? B) A) (strip (fnd ? A) B)
subsets [X@Xs] -> R:(subsets Xs||[[]]) [@R @(map [X @?] R)]
m:ldb Pos Size Value -> with $Pos $Size $Value {P S V -> cl ldb (byte S P) V}
maximize p [M@Xs]
-> Score:M,p fe {X -> (S:X,p) > Score |> do M=:X Score=:S} Xs
-> M
minimize p [M@Xs]
-> Score:M,p fe {X -> (S:X,p) < Score |> do M=:X Score=:S} Xs
-> M
m:while Test @Expr -> {-> $Test |> do $expr (r)}
m:until Test @Expr -> while (n? $Test) $@Expr
m:loop Expr -> {:&r -> do $Expr (&r)}
// Usage: times i:10 say i
m:times Head @Expr ->
$@(do C:Head,{#(`:` $C $N)->C; _->gensym}
N:Head,{#(`:` $C $N)->N; X->X }
#(&E:$N 0,{:&R (&E); $C -> do $Expr (&R $C+1)}))
// for (I:0; I<6; !I+1) say I
m:for #($@V; $@C; $@I) @Body ->
do $@V (cl progn (while (and $@(map ['`!` ?] C))
!$Body $@(map ['`!` ?] I)))
; X 'on Xs @Body -> fe {$X->$@Body} $Xs
// these will generate list of ascending/descending numbers
asc Start -> seq Start (asc Start+1)
dsc Start -> seq Start (dsc Start-1)
// stuff for `++` matcher (we cant use `++` before these funs get defined)
_matchArrayFNS N S F Xs
-> Xs,len%S == 0 && Xs,len/S == N |> (all y? Xs:(grp S Xs | map ?==F) |> [Xs])
_matchArrayFS S F Xs
-> Xs,len%S == 0 |> (all y? Xs:(grp S Xs | map ?==F) |> [Xs])
_matchArrayFN N f Xs -> with N [] Xs
{N Ys [Y:@f @Xs] -> r N-1 [@Ys Y] Xs
;0 Ys [] -> [Ys]}
_matchArrayF f Xs -> with [] Xs
{Ys [Y:@f @Xs] -> r [@Ys Y] Xs
;Ys [] -> [Ys]}
_matchDups Xs -> Xs,len==0 || all Xs,lhd Xs,ltl |> [Xs]
parseInt [Xs:_++!digit?] -> asBase 10 Xs
// FIXME: allow byte order choice
m:defBasicType Sz ->
$@(do SS:[Sz++(gensym)]
#(do (setSizeof '$"s$Sz",asSym $Sz)
(setSizeof '$"s$Sz",asSym $Sz)
($"s$Sz",asSym X ->
V:($"u$Sz",asSym X)
(and V $(1<<(Sz*8-1))) == 0
|> V :: ~(and (inv $(Sz*8) V-1) $(1<<(Sz*8)-1)))
($"u$Sz",asSym [$@SS] ->
$(map ['`<<` ? ??*8] SS [0..Sz-1] | fold ['`+` ? ??]))
($"as_s$Sz",asSym V ->
X:(V<0 |> and (inv $(Sz*8) ~V-1) $(1<<(Sz*8)-1) :: V)
$([0..Sz-1] | map N~>#(`%` X>>$(N*8) 256) | #[$@?]))
($"as_u$Sz",asSym V -> $"as_s$Sz",asSym V)
))
//tableJoin A B by=?,0 ->
// fold {R X->(T:X,by keep ?,by==T B) | map [X ?] | conc R} [[]@A]
// Take initial elements for which `p` is true
takeInit P [@Xs @(nb P)] -> Xs
//insert `sep` between elements of a list `l`
//Usage: infix '+ '(a b c)
//Example: map ?,asInt,asHex "LISP" | infix " " | fold sconc
//TODO: add flag to create "'(+ A (+ B C))" like lists
infix Sep L -> fold {Xs X -> [@Xs Sep X]} [(take 1 L) @L,ltl]
// break list into piles of `n` items
grp N [@Xs] -> [(take N Xs) @(drop N Xs | grp N)]
/* Example1: unfold {1->n; X->[X-1 1]} 7
Example2: qsort Xs -> Xs |
unfold {[X] -> X
;[X@Xs] -> [(keep ?<X Xs) [X] (keep ?>X Xs)]} */
unfold f O -> f O | {[]->[O]; Xs -> mapc (unfold f ?) Xs}
// counts the number of ones in the bit representation of an integer
// use it to calculate size of bitmasks
bitCount X -> cl logcount X
// bit-length of an integer: 2^(log 2 ? | ceil)
bitLen X -> cl `integer-length` X
// inverts `bits` bits in `value` (bitwise not)
inv Bits Value -> cl logxor (ash 1 Bits)-1 Value
exp X -> cl exp X
log Base X -> cl log X Base
sin X -> cl sin X
cos X -> cl cos X
tan X -> cl tan X
asin X -> cl asin X
acos X -> cl acos X
atan X -> cl atan X
sum S -> fold `+` [0@S]
prod S -> fold `*` [1@S]
avg Xs -> Xs,sum/Xs,len
abs X -> num? X |> cl abs X :: sqrt X*X
norm V -> V/V,abs
transpose V -> N:0 [V,lhd,len++(map (do I:N !N+1 ?,I) V)]
rand X:y? -> num? X |> cl random X :: cl ind X (random (len X))
randRng S E -> (abs E+1-S),rand+S
// convert list to set (an ordered list that doesn't have duplicated elements)
uniq L -> L,sort,{[@A X X @B]->[@A @[X @B],r]; E->E}
// set operations
union A B -> A,{[X@Xs]-> fnd X B |> Xs,r :: [x@Xs,r]; _->B}
isect A B -> A,{[X@Xs]-> fnd X B |> [X@Xs,r] :: Xs,r}
diff A B -> union (strip (fnd ? B) A) (strip (fnd ? A) B)
subsets [X@Xs] -> R:(subsets Xs||[[]]) [@R @(map [X @?] R)]
m:ldb Pos Size Value -> with $Pos $Size $Value {P S V -> cl ldb (byte S P) V}
maximize p [M@Xs]
-> Score:M,p fe {X -> (S:X,p) > Score |> do M=:X Score=:S} Xs
-> M
minimize p [M@Xs]
-> Score:M,p fe {X -> (S:X,p) < Score |> do M=:X Score=:S} Xs
-> M
m:while Test @Expr -> {-> $Test |> do $expr (r)}
m:until Test @Expr -> while (n? $Test) $@Expr
m:loop Expr -> {:&r -> do $Expr (&r)}
// Usage: times i:10 say i
m:times Head @Expr ->
$@(do C:Head,{#(`:` $C $N)->C; _->gensym}
N:Head,{#(`:` $C $N)->N; X->X }
#(&E:$N 0,{:&R (&E); $C -> do $Expr (&R $C+1)}))
// for (I:0; I<6; !I+1) say I
m:for #($@V; $@C; $@I) @Body ->
do $@V (cl progn (while (and $@(map ['`!` ?] C))
!$Body $@(map ['`!` ?] I)))
; X 'on Xs @Body -> fe {$X->$@Body} $Xs
// these will generate list of ascending/descending numbers
asc Start -> seq Start (asc Start+1)
dsc Start -> seq Start (dsc Start-1)
// stuff for `++` matcher (we cant use `++` before these funs get defined)
_matchArrayFNS N S F Xs
-> Xs,len%S == 0 && Xs,len/S == N |> (all y? Xs:(grp S Xs | map ?==F) |> [Xs])
_matchArrayFS S F Xs
-> Xs,len%S == 0 |> (all y? Xs:(grp S Xs | map ?==F) |> [Xs])
_matchArrayFN N f Xs -> with N [] Xs
{N Ys [Y:@f @Xs] -> r N-1 [@Ys Y] Xs
;0 Ys [] -> [Ys]}
_matchArrayF f Xs -> with [] Xs
{Ys [Y:@f @Xs] -> r [@Ys Y] Xs
;Ys [] -> [Ys]}
_matchDups Xs -> Xs,len==0 || all Xs,lhd Xs,ltl |> [Xs]
parseInt [Xs:_++!digit?] -> asBase 10 Xs
// FIXME: allow byte order choice
m:defBasicType Sz ->
$@(do SS:[Sz++(gensym)]
#(do (setSizeof '$"s$Sz",asSym $Sz)
(setSizeof '$"s$Sz",asSym $Sz)
($"s$Sz",asSym X ->
V:($"u$Sz",asSym X)
(and V $(1<<(Sz*8-1))) == 0
|> V :: ~(and (inv $(Sz*8) V-1) $(1<<(Sz*8)-1)))
($"u$Sz",asSym [$@SS] ->
$(map ['`<<` ? ??*8] SS [0..Sz-1] | fold ['`+` ? ??]))
($"as_s$Sz",asSym V ->
X:(V<0 |> and (inv $(Sz*8) ~V-1) $(1<<(Sz*8)-1) :: V)
$([0..Sz-1] | map N~>#(`%` X>>$(N*8) 256) | #[$@?]))
($"as_u$Sz",asSym V -> $"as_s$Sz",asSym V)
))
>>16
Autism is not a ``thing'' on /prog/. It never was and it'll never be, no matter how many "so ronery :(" and "social anxiety [part II]" threads people create, believing mistakenly that this is /jp/.
>>34
Unsure. I started Symta for my own amusement. Never designed anything for external consumption. Although I'll probably publish my png/gif decoding library, so you wont need C/C++ bindings to libpng.
>>35
Say, you might as well know that your SDL and PNG dependencies are broken on OS X except under very specific setups. For example, your code looks for "libSDL_image" as a framework, whereas it's distributed as just "SDL_image." Also, I had to change the DYLD_LIBRARY_PATH so it could find libpng in /usr/X11. Seems to work okay though.
Do you have more thorough explanations of the different syntactic features?
Name:
Anonymous2012-11-21 5:55
>>35
There are probably lots of gems in your mess. The problem is that nobody has the kind of time it takes to dig them. Try to write some nice documentation and you will get 5 friendly readers from here.
(setf c (case type
(0 1) ; grayscale
(2 3) ; truecolor
(3 1) ; indexed
(4 4) ; grayscale with alpha
(6 4) ; truecolor with alpha
(otherwise (gfx-load-error "Invalid color type (~d)" type))))
(case depth
((1 2 4) (when (/= c 1)
(gfx-load-error "Invalid color type (~a) for depth ~a" type depth)))
(8)
(otherwise (gfx-load-error "Unsupported channel-depth (~a)" depth)))
(setf g (gfx width height :c c))
(png-defilter g (zlib:unpack IDAT) depth)
(case interlace
(0 ) ; no interlace
(1 (gfx-load-error "Interlaced PNGs are not supported")) ;(png-deinterlace-adam7 g))
(otherwise (gfx-load-error "Invalid interlace type (~d)" interlace)))
(when (= c 1)
(let ((m (if PLTE
(u1-u4 3 PLTE)
(sc u4 (loop as i below 256 collect (rgb i i i))))))
(when tRNS (times i (length tRNS)
(w/rgb (r g b) (aref m i)
(setf (aref m i) (rgb r g b (- #xFF (aref tRNS i)))))))
(setf (gfx-m g) m)))
g)))
(defun png-make (g)
(bind-struct gfx g (w h c d m)
(let* ((o (%new))
(d (cond ((= c 4) (colors-to-bytes (r g b a) (r g b (u- #xFF a)) d))
((= c 3) (colors-to-bytes (r g b) (r g b) d))
(t (u4-u1 1 d)))))
(ser o (magic arr 1 +png-header+))
(png-chunk o "IHDR"
(ser t
(width msb 4 w)
(height msb 4 h)
(depth 1 8)
(type 1 (case c
(1 3) ; indexed
(3 2) ; truecolor
(4 6) ; truecolor with alpha
(otherwise (error "png-create: cant save this image type"))
))
(enc 1 0) ; compression: 0=zlib
(filter 1 0) ; pre-compression-filter: 0=default
(interlace 1 0)))
(when (= c 1)
(png-chunk o "PLTE" (u4-u1 3 m))
(let ((tRNS (vec 256 u1))
(emit nil))
(times i 256
(w/rgb (_ _ _ a) (aref m i)
(setf (aref tRNS i) (u- #xFF a))
(when (/= a 0) (setf emit t))))
(when emit (png-chunk o "tRNS" tRNS))))
(png-chunk o "IDAT" (zlib:pack (png-filter w h c d)))
(png-chunk o "IEND" #())
(%crop o)
)))