mcc_Lisp_0.01_.erl

apply f args = eval [f, ...[[QUOTE, a] | a <- args]...] []    % McCarthy-original-LISP-paper

eval e a | atom e    = head [v | [n, v] <- a, n == e] 
         | otherwise =
  case e of
    [QUOTE,    x]    ->    x                  
    [FUNCTION, x]    ->    [FUNARG, x, a]     
    [EQ,    x, y]    ->    eval x a == eval y a   
    [CONS,  x, y]    ->    [eval x a, ...eval y a...]  
    [CAR,      x]    ->    head ( eval x a )
    [CDR,      x]    ->    tail ( eval x a )  
    [ATOM,     x]    ->    atom ( eval x a )  
    [COND,           ...xs...]  ->  head [eval c a | [t, c] <- xs, eval t a] 
    [[LAMBDA, b, c], ...xs...]  ->  eval  c  [...[[n, eval x a] | n <- b | x <- xs]..., ...a...]  
    [[LABEL,  n, x], ...xs...]  ->  eval [x, ...xs...]  [[n, [LABEL, n, x]], ...a...]           
    [[FUNARG, f, d], ...xs...]  ->  eval [f, ...[[QUOTE, eval x a] | x <- xs]...] d         
    [x,              ...xs...]  ->  eval [eval x a, ...xs...] a              % was: bug:  
                                    %%     ...[eval x a | x <- xs]...] a     % args twice eval'd

%%        eval    e = \a -> case e of [QUOTE, x] ->       x
%%        compile e =       case e of [QUOTE, x] -> \a -> x

apply f args = eval [f, ...[[QUOTE, a] | a <- args]...] []    % McCarthy-original-LISP-paper

eval e a | atom e    = head [v | [n, v] <- a, n == e] 
         | otherwise =
  case e of
    [QUOTE,    x]    ->   x                  
    [FUNCTION, x]    ->   [FUNARG, x, a]     
    [EQ,    x, y]    ->   eval x a == eval y a   
    [CONS,  x, y]    ->   [eval x a, ...eval y a...]  
    [CAR,      x]    ->   head ( eval x a )
    [CDR,      x]    ->   tail ( eval x a )  
    [ATOM,     x]    ->   atom ( eval x a )  
    [COND,           ...xs...]  ->  head [eval c a | [t, c] <- xs, eval t a] 
    [[LAMBDA, b, c], ...xs...]  ->  eval  c  [...[[n, eval x a] | n <- b | x <- xs]..., ...a...]  
    [[LABEL,  n, x], ...xs...]  ->  eval [x, ...xs...]  [[n, [LABEL, n, x]], ...a...]           
    [[FUNARG, f, d], ...xs...]  ->  eval [f, ...[[QUOTE, eval x a] | x <- xs]...] d         
    [x,              ...xs...]  ->  eval [eval x a, ...xs...] a              % was: bug:  
                                    %%     ...[eval x a | x <- xs]...] a     % args twice eval'd

%%        eval    e = \a -> case e of [QUOTE, x] ->       x
%%        compile e =       case e of [QUOTE, x] -> \a -> x

hypothetical alternative syntax for parallel comprehensions / zipN :

    [[LAMBDA, b, c], ...xs...]  ->  eval  c  [...[[n, eval x a] | n <- b | x <- xs]..., ...a...] 
    [[LAMBDA, b, c], ...xs...]  ->  eval  c  [...[[n, eval x a] | (n,x) <- (b,xs)]..., ...a...]
                                                        -- (a,b,c,d,..) <- (as,bs,cs,ds,...)

it is much easier to have guards this way, too.

it'd work by having an imaginary uncurry zipN stuck in there automatically.

example use: a code golf's TIO

another example: primes:

 ps = 2 : [n | (r:q:_, px) <- (tails . (2:) . map (^2) &&& inits) ps,
               (n,True)    <- assocs ( accumArray (const id) True (r+1,q-1)
                                [(m,False) | p <- px, s <- [ (r+p)`div`p*p ], 
                                             m <- [s,s+p..q-1]] :: UArray Int Bool )]

here too it's cumbersome to add guards with the current PLC syntax:

 ps = 2 : [n | (r:q:_, px) <- [(a,b) | a <- tails (2 : map (^2) ps) | b <- inits ps],    % placeholder vars a,b
               (n,True)    <- assocs ( accumArray (const id) True (r+1,q-1)
                                [(m,False) | p <- px, s <- [ (r+p)`div`p*p ], 
                                             m <- [s,s+p..q-1]] :: UArray Int Bool )]

so we end up using the explicit zip - which apparently is less optimizable...

 ps = 2 : [n | (r:q:_, px) <- (zip . tails . (2:) . map (^2) <*> inits) ps,
               (n,True)    <- assocs ( accumArray (const id) True (r+1,q-1)
                                [(m,False) | p <- px, s <- [ (r+p)`div`p*p ], 
                                             m <- [s,s+p..q-1]] :: UArray Int Bool )]