Return Styles: Pseud0ch, Terminal, Valhalla, NES, Geocities, Blue Moon.

Pages: 1-

programming contest

Name: Anonymous 2014-02-10 21:03

Implement a lambda calculus evaluator in whatever language you choose.

I will pick the winner in one week based on undisclosed criteria.

Name: Anonymous 2014-02-10 21:13

Here's my sh implementation:
lambda;

Name: Anonymous 2014-02-10 21:27

>>2
thank you for your submission

Name: Anonymous 2014-02-10 22:46

#The implementation of eval-fun is an exercise left to the reader
(def (eval-lambda-calculus eval-fun expr)
  (eval-fun expr))

Name: Anonymous 2014-02-11 17:33


data Binding = NameBind
type Context = [(String, Binding)]

data Term = TmVariable Int Int
          | TmAbstraction String Term
          | TmApplication Term Term
    deriving (Show, Eq)

termShift :: Int -> Term -> Term
termShift d t = walk 0 t
    where walk c t = case t of
            (TmVariable x n)      -> if x >= c then (TmVariable (x+d) (n+d))
                                     else (TmVariable x (n+d))
            (TmAbstraction x t)   -> (TmAbstraction x (walk (c+1) t))
            (TmApplication t1 t2) -> (TmApplication (walk c t1) (walk c t2))

termSubst :: Int -> Term -> Term -> Term
termSubst j s t = walk 0 t
    where walk c t = case t of
            (TmVariable x n)      -> if x == (j+c) then termShift c s
                                     else (TmVariable x n)
            (TmAbstraction x t)   -> (TmAbstraction x (walk (c+1) t))
            (TmApplication t1 t2) -> (TmApplication (walk c t1) (walk c t2))

termSubstTop :: Term -> Term -> Term
termSubstTop s t = termShift (-1) (termSubst 0 (termShift 1 s) t)

isVal :: Context -> Term -> Bool
isVal _ (TmAbstraction _ _) = True
isVal _ _                   = False

eval1 :: Context -> Term -> Maybe Term
eval1 ctx (TmApplication (TmAbstraction x t) v) | (isVal ctx v)  = Just (termSubstTop v t)
eval1 ctx (TmApplication t1 t2)                 | (isVal ctx t1) = (eval1 ctx t2) >>= (\t2' -> Just (TmApplication t1 t2'))
                                                | otherwise      = (eval1 ctx t1) >>= (\t1' -> Just (TmApplication t1' t2))
eval1 ctx _                                     = Nothing

eval :: Term -> Term
eval t = case (eval1 t) of
            (Just t') -> eval t'
            Nothing   -> t

Name: Anonymous 2014-02-11 17:53

##starts program
Pstart;
print = "welcome to the main menu! do you want to lambda?";
menu {4, if(not_pick; then return EMPTY)}(
(YES; then lambda);(NO; then not_pick);(INFO; then info);(EXIT; then not_pick);
escapefunction(not_pick AND info); end;);
{info}(print = "a program to labmda, made under GNU and BSD. 2014";end;);
Pend.



It's a bit messy, but should do the job alright.

Name: Anonymous 2014-02-11 18:10

>>5
what is this I don't even
 SHALOM!

Name: Anonymous 2014-02-11 18:13

>>5
Haskell a shit


(defun ahmed-eval (expression environment)
  (cond ((symbolp expression) (cadr (assoc expression environment)))
        ((eq (car expression) 'lambda) (cons expression environment))
        (t (ahmed-apply (ahmed-eval (car expression) environment)
                        (ahmed-eval (cadr expression) environment)))))

(defun ahmed-apply (function args)
  (ahmed-eval (cddr (car function))
              (cons (list (cadr (car function)) args)
                    (cdr function))))

(defun ahmed-repl ()
  (loop (print (ahmed-eval (read) nil))))

Name: Anonymous 2014-02-11 19:05

>>5
ftfy, haskbro.


eval :: Context -> Term -> Term
eval ctx t = case (eval1 ctx t) of
            (Just t') -> eval ctx t'
            Nothing   -> t

Name: Anonymous 2014-02-11 19:05

>>4
great job
>>5
a little by the books, but ok
>>6
will test when i get home
>>8
why not just use eval?

Name: Anonymous 2014-02-11 19:31

>>10
Because ahmed-eval evaluates a Lisp object representation of Ahmed Lambda Calculus expressions, but eval evalutes Lisp representations of Lisp programs.

>>5,9
How are you novices not ashamed to post your novice programs in your novice friendly language in a forum for expert programmers? You weren't raised well.

Name: Anonymous 2014-02-11 20:03

>>11

Because I was raised by wolves. Because I'm actually a wolf. *Woof, woof*

Name: Anonymous 2014-02-11 20:07

>>12
Awooooooo~

Name: Anonymous 2014-02-14 3:16


type exp = Sym of string | Lam of string * exp | App of exp * exp
type den = Closed of string * exp * (string * den) list
let rec eval' env = function
  | Sym x      -> List.assoc x env
  | Lam (x, e) -> Closed (x, e, env)
  | App (f, x) -> match eval' env f with
    | Closed (name, body, env') -> eval' ((name, eval' env x) :: env') body
let eval = eval' []


or if you're an ANUSEXPERT PROGRAMMER:


type cddaar = [ `Cdraadaarda of string ]
type cdadar = [ cddaar | `Cdraaddrrda of cddaar * cdadar | `Cdraadarrda of cdadar * cdadar ]
type cdaadr = ConsMyAnus of ([`Cdraaddrrda of cddaar * cdadar] * (cddaar * cdaadr) list)

let rec eval' env = function
  | `Cdraadaarda _ as x -> List.assoc x env
  | `Cdraaddrrda _ as x -> ConsMyAnus (x, env)
  | `Cdraadarrda (f, x) -> match eval' env f with
    | ConsMyAnus (`Cdraaddrrda (caar, cadr), cdr) -> eval' ((caar, eval' env x) :: cdr) cadr
let eval = eval' []

let lam x b : cdadar = `Cdraaddrrda (x, b)
let app f x : cdadar = `Cdraadarrda (f, x)

let y = `Cdraadaarda "y"
let x = `Cdraadaarda "x"
let z = `Cdraadaarda "z"
let w = `Cdraadaarda "w"

let ya = eval (app (app (lam x (lam y x)) (lam w w)) (app (lam x x) (lam z z)))

Name: Anonymous 2014-02-15 21:04

[code]
type
  TKind = enum sym, cons, null, lam
  TCons[T] = tuple[car,cdr: ref T]
  TREnv = seq[TLispObj] # runtime environment
  TCEnv = seq[string]   # compile-time environment
  TLispFunc = proc(env:TREnv): TLispObj
  TLambdaVal = tuple[env: TREnv, body: TLispFunc, print_rep: string]
  TLispObj = object
    case kind*: TKind
    of sym: symval: string
    of cons: consval: TCons[TLispObj]
    of null: nil
    of lam: funcval: TLambdaVal


proc compile_lambda(expr:TLispObj, env:TCEnv): TLispFunc


proc get_print_rep(expr:TLispObj): string =
  if expr.kind == sym:
    return expr.symval
  if expr.kind == cons:
    return "(" & get_print_rep(expr.consval.car[]) & " " & get_print_rep(expr.consval.cdr[]) & ")"
  if expr.kind == null:
    return "()"
  if expr.kind == lam:
    return expr.funcval.print_rep



proc extend_cte(sym:TLispObj, env:TCEnv): TCEnv =
  var new_env = env
  add(new_env, sym.symval)
  return new_env

proc extend_rte(val:TLispObj, env:TREnv): TREnv =
  var new_env = env
  add(new_env, val)
  return new_env

proc lookup_sym(sym:string, env:TCEnv): int =
  var idx = 0
 
  while(idx < env.len):
    if(env[idx] == sym):
      return idx
    inc(idx)
   
  raise newException(E_Base, "Unbound variable at compile-time: " & sym)

proc compile_symbol_lookup(sym:TLispObj, env:TCEnv): TLispFunc =
  var idx = lookup_sym(sym.symval, env)
  var func = proc(renv: TREnv): TLispObj =
    return renv[idx]
  return func


proc compile_make_lambda(arg:TLispObj, body:TLispObj, env:TCEnv): TLispFunc =
  var new_env = extend_cte(arg, env)
  var inner_func = compile_lambda(body, new_env)
  var func = proc(renv: TREnv): TLispObj =
    var lamb = (env: renv, body: inner_func, print_rep: ("(lambda (" & arg.symval & ") " & get_print_rep(body) & ")"))
    var inner_obj = TLispObj(kind:lam, funcval: lamb)
    return inner_obj
  return func

proc compile_application(operator:TLispObj, operand:TLispObj, env:TCEnv): TLispFunc =
 
  var operand_func = compile_lambda(operand, env) # compile operand
  var operator_func = compile_lambda(operator, env) # compile operator
 
  var rt_func = proc(renv:TREnv): TLispObj =
    var operand = operand_func(renv)
    var operator = operator_func(renv)
    var lam = operator.funcval
    var func_env = lam.env
    var new_env = extend_rte(operand, func_env)
    return lam.body(new_env)
  return rt_func

proc compile_lambda(expr:TLispObj, env:TCEnv): TLispFunc =
  if (expr.kind == sym):
    return compile_symbol_lookup(expr, env)
  if (expr.kind == cons):
    var car = expr.consval.car
    var cdr = expr.consval.cdr
    if (car.kind == sym and car.symval == "lambda"):
      return compile_make_lambda(cdr.consval.car[], cdr.consval.cdr[], env)
    else:
      return compile_application(car[], cdr[], env)

Name: Anonymous 2014-02-15 21:05

ignore last post, i have not yet mastered bbcode


type
  TKind = enum sym, cons, null, lam
  TCons[T] = tuple[car,cdr: ref T]
  TREnv = seq[TLispObj] # runtime environment
  TCEnv = seq[string]   # compile-time environment
  TLispFunc = proc(env:TREnv): TLispObj
  TLambdaVal = tuple[env: TREnv, body: TLispFunc, print_rep: string]
  TLispObj = object
    case kind*: TKind
    of sym: symval: string
    of cons: consval: TCons[TLispObj]
    of null: nil
    of lam: funcval: TLambdaVal


proc compile_lambda(expr:TLispObj, env:TCEnv): TLispFunc


proc get_print_rep(expr:TLispObj): string =
  if expr.kind == sym:
    return expr.symval
  if expr.kind == cons:
    return "(" & get_print_rep(expr.consval.car[]) & " " & get_print_rep(expr.consval.cdr[]) & ")"
  if expr.kind == null:
    return "()"
  if expr.kind == lam:
    return expr.funcval.print_rep



proc extend_cte(sym:TLispObj, env:TCEnv): TCEnv =
  var new_env = env
  add(new_env, sym.symval)
  return new_env

proc extend_rte(val:TLispObj, env:TREnv): TREnv =
  var new_env = env
  add(new_env, val)
  return new_env

proc lookup_sym(sym:string, env:TCEnv): int =
  var idx = 0
 
  while(idx < env.len):
    if(env[idx] == sym):
      return idx
    inc(idx)
  
  raise newException(E_Base, "Unbound variable at compile-time: " & sym)

proc compile_symbol_lookup(sym:TLispObj, env:TCEnv): TLispFunc =
  var idx = lookup_sym(sym.symval, env)
  var func = proc(renv: TREnv): TLispObj =
    return renv[idx]
  return func


proc compile_make_lambda(arg:TLispObj, body:TLispObj, env:TCEnv): TLispFunc =
  var new_env = extend_cte(arg, env)
  var inner_func = compile_lambda(body, new_env)
  var func = proc(renv: TREnv): TLispObj =
    var lamb = (env: renv, body: inner_func, print_rep: ("(lambda (" & arg.symval & ") " & get_print_rep(body) & ")"))
    var inner_obj = TLispObj(kind:lam, funcval: lamb)
    return inner_obj
  return func

proc compile_application(operator:TLispObj, operand:TLispObj, env:TCEnv): TLispFunc =
 
  var operand_func = compile_lambda(operand, env) # compile operand
  var operator_func = compile_lambda(operator, env) # compile operator
 
  var rt_func = proc(renv:TREnv): TLispObj =
    var operand = operand_func(renv)
    var operator = operator_func(renv)
    var lam = operator.funcval
    var func_env = lam.env
    var new_env = extend_rte(operand, func_env)
    return lam.body(new_env)
  return rt_func

proc compile_lambda(expr:TLispObj, env:TCEnv): TLispFunc =
  if (expr.kind == sym):
    return compile_symbol_lookup(expr, env)
  if (expr.kind == cons):
    var car = expr.consval.car
    var cdr = expr.consval.cdr
    if (car.kind == sym and car.symval == "lambda"):
      return compile_make_lambda(cdr.consval.car[], cdr.consval.cdr[], env)
    else:
      return compile_application(car[], cdr[], env)

Name: Anonymous 2014-02-16 3:35

Name: Anonymous 2014-02-17 15:26

If I do Lisp syntax, should (f x y z) pass a list and (f . x) be plain application or should (f x y z) be curried form like (((f x) y) z)?

Name: Anonymous 2014-02-17 16:38

>>17
Why do you keep posting this everywhere

Name: Anonymous 2014-02-17 17:56

I drew you a picture of lambada calcius. I'm pretty sure this is what it looks like.
    ,,,`````Vò---^
<[u]```[/u],,___| /_,vvvv
    w     w  `[u]'^^[/u],
 ,--,
(    )
 `--'

Name: Anonymous 2014-02-17 17:58

wait, fuck
[pre]
    ,,,`````Vò---^
<```,,___| /_,vvvv
    w     w  `'^^,
 ,--,
(    )
 `--'
[/pre]

Name: Anonymous 2014-02-17 17:59

Help, how do i prog?

Name: Anonymous 2014-02-17 18:03


    ,,,`````Vò---^
<
```,,___| /_,vvvv
    w     w  `
'^^,
 ,--,
(    )
 `--'

I'll figure this out.

Name: Anonymous 2014-02-17 21:09

>>20,21,23
This is what it should look like: http://i.imgur.com/xJxM1dk.png

Name: Anonymous 2014-02-17 21:12

Name: Anonymous 2014-02-17 21:42

>>24
This looks nothing like the texts I read.

Name: Anonymous 2014-02-17 22:08

>>26
Really? Compare it to the cover of SICP.

Name: Anonymous 2014-02-18 15:46

It's been a week, OP. Time to judge!

Name: Anonymous 2014-02-18 19:17

>>26
>le pedophile sage

Name: Anonymous 2014-02-18 20:35

>>28
you're right!

with so many good submissions, i'm not sure who to pick though

care to vote on it, guys?

Name: Anonymous 2014-02-18 21:09

>>30
I vote for >>13

Name: Anonymous 2014-02-18 22:52

>>30
I vote >>33

Name: Anonymous 2014-02-18 22:58

>>32
thanks

Name: Anonymous 2014-02-18 23:26

I vote for >>34

Name: Anonymous 2014-02-19 0:05

>>34
Fuck you.
I vote for >>2

Name: Anonymous 2014-02-19 0:47

>>35
you may not like me but I still like you
I change my vote to >>35

with love~

Name: Anonymous 2014-02-19 2:32

I vote >>-34,36- because screw >>35

Name: Anonymous 2014-02-19 2:35

>>37
Thanks for the vote!

Name: Anonymous 2014-02-19 8:35

>>37
Awww c'mon

Name: Anonymous 2014-02-19 11:09

>>37
Danke!

Don't change these.
Name: Email:
Entire Thread Thread List