cg #49

entry #1

written by IFcoltransG
submitted at 2023-12-17T07:04:59.894823+00:00
0 likes

guesses

IFcoltransG (by yui)
LyricLy (by vspf)
luatic (by olus2000)
olus2000 (by Palaiologos)
taswelll (by LyricLy)
taswelll (by luatic)
vspf (by taswelll)

comments 1

IFcoltransG ¶

Interesting that line 314 uses double quotes.

post a comment

lisp.py ASCII text

QUOTE = '"'
QUASIQUOTE = '`'
UNQUOTE = ','

std_env = {
    '+': sum,
    'list': list,
    'let': {'macro': 'let'},
    'fun': {'macro': 'lambda'},
    'macro': {'macro': 'macro'},
    'select': {'macro': 'select'},
    'eval': {'macro': 'eval'},
    'case': {'macro': 'case'},
    'true': [[]],  # just empty binding
    'false': [],  # no bindings
    QUOTE: {'macro': 'quote'},
    QUASIQUOTE: {'macro': 'quasiquote'},
}


def run(exprs, env=std_env):
    env = dict(env)
    env_stack = []
    value_stack = []
    command_stack = list(exprs)
    while command_stack:
        match command_stack.pop():
            case int(num):
                value_stack.append(num)
            case str(ident):
                value_stack.append(env[ident])
            case list([]):
                value_stack.append([])
            case list([func, *args]):
                command_stack.append({'apply': args})
                command_stack.append(func)
            case {'apply': args}:
                # when 'apply' runs, func eval'd onto val stack
                # args not eval'd
                match value_stack.pop(), args:
                    case func, args if callable(func):
                        command_stack.append(
                            {'call': func, 'arity': len(args)})
                        for arg in args:
                            command_stack.append(arg)
                    case {
                        'params': patterns,
                        'lambda_body': _,
                        'env': dict(_),
                    } as func, args:
                        # lambda
                        if len(args) != len(patterns):
                            raise ValueError(
                                f'expected parameters {patterns}, found args {args}'
                            )
                        command_stack.append(
                            {'call': func, 'arity': len(args)})
                        for arg in args:
                            command_stack.append(arg)
                    case {
                        'params': patterns,
                        'macro_body': _,
                        'env': dict(_),
                    } as func, args:
                        # user macro
                        if len(args) != len(patterns):
                            raise ValueError(
                                f'expected parameters {patterns}, found args {args}'
                            )
                        # eval result of macro
                        command_stack.append(
                            {'call': {'macro': 'eval'}, 'arity': 1})
                        command_stack.append(
                            {'call': func, 'arity': len(args)})
                        while args:
                            # reverse order, args never popped from cmd stack
                            value_stack.append(args.pop())
                    case {'macro': 'eval'} as func, args:
                        command_stack.append(
                            {'call': func, 'arity': len(args)})
                        for arg in args:
                            command_stack.append(arg)
                    case {'macro': 'quote'}, [arg]:
                        value_stack.append(arg)
                    case {'macro': 'quasiquote'}, [arg]:
                        match arg:
                            case list([quasiquote, quoted] as arg) if quasiquote == QUASIQUOTE:
                                value_stack.append(arg)
                            case list([unquote, unquoted]) if unquote == UNQUOTE:
                                command_stack.append(unquoted)
                            case list(quoted_list):
                                command_stack.append(
                                    [
                                        'list',
                                        *(
                                            [QUASIQUOTE, element]
                                            for element in quoted_list
                                        ),
                                    ]
                                )
                            case _:
                                value_stack.append(arg)
                    case {'macro': 'let'}, [*patterns, body]:
                        command_stack.append({'restore_env': None})
                        command_stack.append(body)
                        for key, value in patterns:
                            command_stack.append({'set': key})
                            command_stack.append(value)
                        command_stack.append({'enter_env': {}})
                    case {'macro': 'lambda'}, [patterns, body]:
                        value_stack.append(
                            {'params': patterns, 'lambda_body': body,
                                'env': dict(env)}
                        )
                    case {'macro': 'macro'}, [patterns, body]:
                        value_stack.append(
                            {'params': patterns, 'macro_body': body,
                                'env': dict(env)}
                        )
                    case {'macro': 'select'}, list(
                        [(condition, body), *clauses, otherwise]
                    ):
                        command_stack.append(
                            {'select': clauses, 'body': body,
                                'otherwise': otherwise}
                        )
                        command_stack.append(condition)
                    case {'macro': 'case'}, list([*patterns, expr] as args):
                        command_stack.append(
                            {'call': {'macro': 'case'}, 'arity': len(args)})
                        for pattern in patterns:
                            value_stack.append(pattern)
                        command_stack.append(expr)
                    case {'macro': name}, args:
                        raise TypeError(
                            f'expected {name} macro parameters, found {args}'
                        )
                    case _:
                        raise TypeError(f'expected callable, found {func}')
            case {'call': func, 'arity': int(arity)}:
                # func eval'd, args eval'd
                args = [value_stack.pop() for _ in range(arity)]
                match func:
                    case {
                        'params': patterns,
                        'lambda_body': body,
                        'env': dict(saved_env),
                    }:
                        # lambda
                        command_stack.append({'restore_env': None})
                        command_stack.append(
                            {
                                'apply': [
                                    *([pattern, [QUOTE, arg]]
                                      for pattern, arg in zip(patterns, args)),
                                    body,
                                ]
                            }
                        )
                        value_stack.append({'macro': 'let'})
                        command_stack.append({'enter_env': saved_env})
                    case {
                        'params': patterns,
                        'macro_body': body,
                        'env': dict(saved_env),
                    }:
                        # user macro
                        command_stack.append({'restore_env': None})
                        command_stack.append(
                            {
                                'apply': [
                                    *([pattern, [QUOTE, arg]]
                                      for pattern, arg in zip(patterns, args)),
                                    body,
                                ]
                            }
                        )
                        value_stack.append({'macro': 'let'})
                        command_stack.append({'enter_env': saved_env})
                    case {'macro': 'eval'}:
                        for arg in args:
                            command_stack.append(arg)
                    case {'macro': 'case'}:
                        [expr, *patterns] = args
                        command_stack.append(
                            {'cases': 'or', 'arity': len(patterns)})
                        patterns.reverse()
                        for pattern in patterns:
                            command_stack.append(
                                {'case': pattern, 'expr': expr})
                    case func if callable(func):
                        value_stack.append(func(args))
                    case func:
                        raise ValueError(f'expected call, found {func}')
            case {'select': clauses, 'body': body, 'otherwise': otherwise}:
                match value_stack.pop():
                    case list([bindings, *_]):
                        # success
                        command_stack.append({'restore_env': None})
                        command_stack.append(body)
                        command_stack.append(
                            {'enter_env': {key: value for [
                                key, value] in bindings}}
                        )
                    case _:
                        match clauses:
                            case []:
                                # no clauses left
                                command_stack.append(otherwise)
                            case [(condition, body), *clauses]:
                                command_stack.append(
                                    {
                                        'select': clauses,
                                        'body': body,
                                        'otherwise': otherwise,
                                    }
                                )
                                command_stack.append(condition)
            case {'case': pattern, 'expr': expr}:
                match pattern, expr:
                    case list([unquote, str(ident)]), expr if unquote == UNQUOTE:
                        # can bind wildcard
                        value_stack.append([[[ident, expr]]])
                    case int(pattern), int(expr) if pattern == expr:
                        value_stack.append([[]])
                    case list(patterns), list(exprs) if len(patterns) == len(exprs):
                        # bind elements
                        command_stack.append(
                            {'cases': 'and', 'arity': len(patterns)})
                        for pattern, expr in zip(patterns, exprs):
                            command_stack.append(
                                {'case': pattern, 'expr': expr})
                    case _:
                        value_stack.append([])
            case {'cases': 'and', 'arity': arity}:
                patterns = [value_stack.pop() for _ in range(arity)]
                matches = [[]]
                for pattern in patterns:
                    new_matches = []
                    for match in matches:
                        for option in pattern:
                            new_match = match + option
                            idents = [ident for ident, _ in new_match]
                            if len(idents) == len(set(idents)):
                                new_matches.append(new_match)
                    matches = new_matches
                value_stack.append(matches)
            case {'cases': 'or', 'arity': arity}:
                patterns = [value_stack.pop() for _ in range(arity)]
                value_stack.append(
                    [pattern for match in patterns for pattern in match])
            case {'enter_env': new_env}:
                env_stack.append(dict(env))
                env |= new_env
            case {'restore_env': None}:
                env = env_stack.pop()
            case {'set': key}:
                env[key] = value_stack.pop()
            case command:
                raise ValueError(f'expected command, found {command}')
    return value_stack


def read(s):
    o = [[]]
    for symbol in '()[]`,"':
        s = s.replace(symbol, f' {symbol} ')
    for t in s.split():
        match t:
            case '(' | '[':
                o.append([])
            case ')' | ']':
                tmp = o.pop()
                o[-1].append(tmp)
            case str(num) if num.isnumeric():
                o[-1].append(int(num))
            case str(ident):
                o[-1].append(ident)
    [o] = o
    return o


tutorials = [
    ('(+ 1 2 3)', 6),
    ('(let (a 1) (b 2) (c 3) (d 4) b)', 2),
    ('((fun (x) x) 0)', 0),
    ('((fun (a b c d) b) 1 2 3 4)', 2),
    ('(select (false 1) (true 2) (true 3) 4)', 2),
    ('(select (false 1) (false 2) (false 3) 4)', 4),
    ('true', [[]]),
    ('false', []),
    ('(case 1 (+ 1 1))', []),
    ('(case 2 (+ 1 1))', [[]]),
    ('(case (, x) (+ 1 1))', [[['x', 2]]]),
    ('(case [[(,x) (,y) 3] (,z)] (" ((1 2 3) (4 5 6))))',
     [[['x', 1], ['y', 2], ['z', [4, 5, 6]]]]),
    ('(select ((case (, x) 1) (+ x 2)) 0)', 3),
    ('(select ((case ((, x) (, y)) (" (1 2))) (+ x y)) 0)', 3),
    ('(let (no []) (select (no 0) 1))', 1),
    ('(let (bind-a (` [[(a (, 0))]])) (select (bind-a a) 1))', 0),
    ('(case 1 2 3 (,x) (,y) (+ 1 1))', [[], [['x', 2]], [['y', 2]]]),
    ('(` (1 2 (+ 3 4) (, (+ 5 6))))', [1, 2, ['+', 3, 4], 11]),
    ('(` (` (, (+ 1 1))))', ['`', [',', ['+', 1, 1]]]),
    ('((fun () (" (+ 1 1))))', ['+', 1, 1]),
    ('((macro () (" (+ 1 1))))', 2),
    ('((macro (x) (` (+ 2 (, x)))) 1)', 3),
    ('((macro (x y z) (` ((,x) (,y) (,z)))) + 2 3)', 5),
    ('(let (if (macro (c t f) (` (select ((, c) (, t)) (, f))))) (if true 1 2))', 1),
    ('(let (x 0) (select [(case 0 x) (" zero)] [(case 1 x)] (" one) (" big)))', 'zero'),
    ('(let (car (fun (pair) (select [(case [(,car) (,cdr)] pair) car] (" error)))) (car (" [1 2])))', 1),
    ('(let (cdr (fun (pair) (select [(case [(,car) (,cdr)] pair) cdr] (" error)))) (cdr (" [1 2])))', 2),
]

if __name__ == "__main__":
    for (tutorial, answer) in tutorials:
        print(tutorial)
        [o] = run(read(tutorial))
        if o != answer:
            print(f'expected {answer}')
        print(f'found {o}')
        print()

entry #2

written by luatic
submitted at 2023-12-28T10:35:57.748818+00:00
0 likes

guesses

Palaiologos (by vspf)
luatic (by IFcoltransG)
luatic (by LyricLy)
luatic (by taswelll)
luatic (by Palaiologos)
luatic (by yui)
yui (by olus2000)

comments 0

post a comment

crisp.rkt ASCII text

#lang racket
(define (proceed-parse in) (read-char in) (parse in))
(define (assert cond) (when (not cond) (raise "assertion failed")))
(define (expect in c) (assert (eqv? c (read-char in))))
(define (read-atom in)
  (let [(c (peek-char in))]
    (if (or (char-whitespace? c) (char=? #\) c)) '()
        (begin (read-char in) (cons c (read-atom in))))))
(define (skip-line in)
  (if (eqv? #\newline (read-char in)) (void) (skip-line in)))
(define (parse in)
  (let [(c (peek-char in))]
    (cond
      [(or (eof-object? c) (char=? #\) c)) '()]
      [(char=? #\# c) (begin (skip-line in) (parse in))]
      [(char-whitespace? c) (proceed-parse in)]
      [(char=? #\( c) (let [(r (proceed-parse in))]
                        (begin (expect in #\)) (cons r (parse in))))]
      [else (cons (let [(s (list->string (read-atom in)))]
                    (or (string->number s) (list 'name s)))
                  (parse in))])))
(define (fnify f)
  (lambda (args ctx) (f (eval-args args ctx))))
(define (thunk args ctx)
  (fnify (lambda (_) (last (eval-args args ctx)))))
(define (my-lambda args ctx)
  (letrec [(param (begin (assert (eqv? 'name (caar args))) (cadar args)))
           (body (cdr args))
           (f (lambda (xs)
                (if (null? xs) f
                    (let* [(new-ctx (hash-set ctx param (car xs)))
                           (res (last (eval-args body new-ctx)))]
                      (if (null? (cdr xs)) res
                          (res (cdr xs) ctx))))))]
    (fnify f)))
(define (my-quote args _) args)
(define (fnify-n n f)
  (letrec [(l (lambda (args ctx)     
                (if (null? args) l
                    (let [(arg (eval (car args) ctx))]
                      (if (= n 1)
                          (if (null? (cdr args))
                              (f arg)
                              ((f arg) (eval-args (cdr args) ctx)))
                          ((fnify-n (- n 1) (curry f arg)) (cdr args) ctx)))
                    )))] l))
(define my-t (fnify-n 2 (lambda (x y) x)))
(define my-f (fnify-n 2 (lambda (x y) y)))
(define (my-<= n m)
  (cond
    [(eq? n m) my-t]
    [(and (number? n) (number? m)) (if (<= n m) my-t my-f)]
    [(null? n) (if (pair? m) my-t my-f)]
    [(and (pair? n) (pair? m))
     (cond
       [(not (my-<= (car n) (car m))) my-f]
       [(not (my-<= (car m) (car n))) my-t]
       [else (my-<= (cdr n) (cdr m))])]
    [else my-f]))
(define (d args)
  (display args)
  (newline))
(define (my-macro margs mctx)
  (lambda (args ctx)
    (eval (last (eval-args margs (hash-set ctx "..." args))) ctx)))
(define predefs
  (hash
   ;; builtins (mostly inherited from racket)
   "d" (fnify d)
   "ib" (fnify (lambda (_) (char->integer (read-char))))
   "ob" (fnify-n 1 (lambda (c) (write-char (integer->char c))))
   "do" (fnify last)
   "car" (fnify-n 1 car)
   "cdr" (fnify-n 1 cdr)
   "cons" (fnify-n 2 cons)
   "list" (fnify identity)
   "-" (fnify-n 1 -)
   "+" (fnify-n 2 +)
   "*" (fnify-n 2 *)
   "<=" (fnify-n 2 my-<=)
   "t" my-t
   "f" my-f
   ;; special forms
   "\\\\" thunk
   "\\" my-lambda
   "'" my-quote
   "$" my-macro)) 
(define (eval-args args ctx)
  (map (lambda (arg) (eval arg ctx)) args))
(define (eval expr ctx)
  (if (pair? expr)
      (let [(f (car expr)) (args (cdr expr))]
        (if (eqv? f 'name) (hash-ref ctx (car args))
            ((eval f ctx) args ctx)))
      expr))
(define (get-file-name)
  (command-line
   #:program "crisp"
   #:args (filename)
   filename))
(define (maybe-display v)
  (when (not (eq? v (void))) (display v)))
(maybe-display (eval
                (cons (list 'name "do")
                      (call-with-input-file (get-file-name) parse))
                predefs))

stuff.crisp ASCII text

# she bangs
# (all lines starting with # actually) are ignored

# run this using "racket crisp.rkt stuff.crisp"

# d is a debug print for a list of arguments
(d 1 2 3)
# (ib) reads a byte, (ob b) writes a byte
(ob 65)
# (d (ib))
# basic math works; - is unary; +, * are strictly binary, fold them yourself
(d (+ (+ (* 4 5) (* 2 3)) (- 1)))
# lambdas (single parameter only)
(d ((\ x (\ y (+ x y))) 1 2))
# you can quote stuff, albeit unusually
(d (' + 1 2))
# automatic currying
(d (+ 1))
(d 42)
(d ((+ 1) 2))
(d 69)
# "thunks" (paramless lambdas)
(d ((\\ (+ 1 2))))
# we've got cons, car, cdr, list
(d (cons 1 2))
(d (car (cons 1 2)))
(d (cdr (cons 1 2)))
(d (')) # empty list
(d (cons 1 ('))) # list with one elem
(d (list 1 2 3))
# bools are just functions
(d (t 1 0))
(d (f 1 0))
(d (<= 1 2))
(d ((<= 1 2) 1 0))
# <= is special: it compares lexicographically and can be used to test for nil
(d ((<= (') (')) 1 0))
(d ((<= (') (' 1 2)) 1 0))
(d ((<= (' 1 2) (')) 1 0))
(d ((<= (' 1 2) (' 1 2)) 1 0))
# this is enough for a simple recursive fibonacci already
(d ((\ f (f f 10))
	(\ f (\ n (((<= n 1)
		(\\ n)
		(\\ (+ (f f (+ n (- 1))) (f f (+ n (- 2)))))))))))
# multiple things are awkward here:
# - nesting of lambdas
# - no let(rec)
# - thunks
# it's time to introduce "macros". macros are like functions,
# except they operate on the raw sexprs rather than the evaluated sexprs.
# $ is like \, but the parameter is always called ... and is implicit.
# "macro" "expansion" happens at runtime.
(d (($ (car ...)) 1 2 3))
(($ (d (list (car (' d)) ...)) (cons (car (' d)) ...)) 1 2 3)
(($ ...
	(list (list
		(car ...)
		(list (car (' \\)) (car (cdr ...)))
		(list (car (' \\)) (car (cdr (cdr ...)))))))
	t (d 1) (d 0))
# macros to solve the other problems are left as exercises to the reader

entry #3

written by taswelll
submitted at 2023-12-27T18:06:43.426335+00:00
0 likes

guesses

IFcoltransG (by luatic)
LyricLy (by Palaiologos)
LyricLy (by yui)
taswelll (by olus2000)
taswelll (by vspf)
yui (by IFcoltransG)
yui (by LyricLy)

comments 0

post a comment

entry.clisp ASCII text

1	(define (entry n) (eval n))

entry #4

written by olus2000
submitted at 2023-12-23T17:08:53.359526+00:00
2 likes

guesses

olus2000 (by IFcoltransG)
olus2000 (by LyricLy)
olus2000 (by taswelll)
olus2000 (by luatic)
olus2000 (by yui)
olus2000 (by vspf)
vspf (by Palaiologos)

comments 2

ten bees ¶

there are a nonnegative amount of characters in this entry i must say

olus2000 ¶

I certainly exerted some form of effort into it.

post a comment

dir minor-L

dir src

Interpretter.elm ASCII text

module Interpretter exposing (..)


import LispParser as LP exposing (AST, Statement)
import Dict exposing (Dict)
import Result


type Value
  = Symbol String
  | Integer Int
  | Quoted Value
  | Cons Value Value
  | Fun Function
  | Null


type alias Environment = Dict String Value


type Function
  = Builtin (Environment -> Value -> Result String Value)
  | Closure Environment Skeleton Value


type alias InterpreterState =
  { defs : Environment
  , macros : Environment
  , result : List (Result String Value)
  }


type Skeleton
  = ConsPattern Skeleton Skeleton
  | Capture String
  | Wildcard


interpret : InterpreterState -> List Statement -> InterpreterState
interpret state stmts = case stmts of
  [] -> state
  LP.MacroDef name ast :: rest ->
    case resolve state.macros ast |> Result.andThen (eval state.defs) of
      Err s ->
        { state
        | result =
          Err ("Error in macro definition " ++ name ++ ":\n" ++ s) ::
          state.result
        }
      Ok expr -> interpret
        { state | macros = Dict.insert name expr state.macros }
        rest
  LP.FunctionDef name ast :: rest ->
    case resolve state.macros ast |> Result.andThen (eval state.defs) of
      Err s ->
        { state
        | result =
          Err ("Error in function definition " ++ name ++ ":\n" ++ s) ::
          state.result
        }
      Ok expr -> interpret
        { state | defs = Dict.insert name expr state.defs }
        rest
  LP.RawExpression ast :: rest -> interpret
    { state
    | result = (resolve state.macros ast
                |> Result.andThen (eval state.defs)) :: state.result
    }
    rest


resolve : Environment -> AST -> Result String Value
resolve macros ast = case ast of
  LP.Variable s -> Ok (Symbol s)
  LP.Integer n -> Ok (Integer n)
  LP.Quoted q -> resolve macros q |> Result.map Quoted
  LP.ConsList (LP.Variable name :: rest) -> case resolveList macros rest of
    Ok args -> case Dict.get name macros of
      Nothing -> Ok (Cons (Symbol name) args)
      Just macro -> call Dict.empty macro args
    Err s -> Err s
  LP.ConsList rest -> resolveList macros rest


resolveList : Environment -> List AST -> Result String Value
resolveList macros l = case l of
  head :: rest -> case resolve macros head of
    Err s -> Err s
    Ok headValue -> case resolveList macros rest of
      Err s -> Err s
      Ok restValue -> Ok (Cons headValue restValue)
  [] -> Ok Null


eval : Environment -> Value -> Result String Value
eval defs val = case val of
  Symbol s -> case Dict.get s defs of
    Just v -> Ok v
    Nothing -> Err ("Unknown symbol: " ++ s)
  Quoted expr -> Ok expr
  Cons carExpr cdrExpr -> case eval defs carExpr of
    Err s -> Err s
    Ok car -> case calllessEval defs cdrExpr of
      Err s -> Err s
      Ok cdr -> call defs car cdr
  _ -> Ok val


calllessEval : Environment -> Value -> Result String Value
calllessEval defs val = case val of
  Cons carExpr cdrExpr -> case eval defs carExpr of
    Err s -> Err s
    Ok car -> case calllessEval defs cdrExpr of
      Err s -> Err s
      Ok cdr -> Ok (Cons car cdr)
  _ -> eval defs val


call : Environment -> Value -> Value -> Result String Value
call defs fun args = case fun of
  Fun func -> case func of
    Builtin f -> f defs args
    Closure env params body -> case assign env params args of
      Just x -> eval x body
      Nothing ->
        Err ("Bad argument shape! Expected:\n" ++ skeletonToString params
             ++ "\nGot:\n" ++ valueToString body ++ "\n")
  _ -> Err ("Attempt to call a value that is not callable:\n"
            ++ valueToString fun)


assign : Environment -> Skeleton -> Value -> Maybe Environment
assign env pattern args = case pattern of
  Wildcard -> Just env
  Capture s -> Just (Dict.insert s args env)
  ConsPattern carPattern cdrPattern ->
    case args of
      Cons car cdr -> assign env carPattern car
        |> Maybe.andThen (\x -> assign x cdrPattern cdr)
      _ -> Nothing


skeletonToString : Skeleton -> String
skeletonToString s =
  case toConsListPattern s of
    Just l -> "(" ++ consListPatternToString l ++ ")"
    Nothing -> case s of
      Wildcard -> "()"
      Capture name -> name
      ConsPattern car cdr ->
        "(. " ++ skeletonToString car ++ " " ++ skeletonToString cdr ++ ")"


toConsListPattern : Skeleton -> Maybe (List Skeleton)
toConsListPattern s = case s of
  Wildcard -> Just []
  ConsPattern car cdr -> case toConsListPattern cdr of
    Nothing -> Nothing
    Just cdrList -> Just (car :: cdrList)
  _ -> Nothing


consListPatternToString : List Skeleton -> String
consListPatternToString l = case l of
  head :: [] -> skeletonToString head
  head :: rest -> skeletonToString head ++ " " ++ consListPatternToString rest
  [] -> ""



valueToString : Value -> String
valueToString v =
  case toConsList v of
    Just l ->  "(" ++ consListToString l ++ ")"
    Nothing -> case v of
      Null -> "()"
      Symbol s -> s
      Cons car cdr ->
        "(. " ++ valueToString car ++ " " ++ valueToString cdr ++ ")"
      Quoted e -> "'" ++ valueToString e
      Integer n -> String.fromInt n
      Fun (Builtin _) -> "~builtin~"
      Fun (Closure _ params _) ->
        "(~closure~ " ++ skeletonToString params ++ ")"


toConsList : Value -> Maybe (List Value)
toConsList s = case s of
  Null -> Just []
  Cons car cdr -> case toConsList cdr of
    Nothing -> Nothing
    Just cdrList -> Just (car :: cdrList)
  _ -> Nothing


consListToString : List Value -> String
consListToString l = case l of
  head :: [] -> valueToString head
  head :: rest -> valueToString head ++ " " ++ consListToString rest
  [] -> ""

Lexer.elm ASCII text

module Lexer exposing (..)


import Parser exposing (Parser, (|.), (|=), symbol, succeed, oneOf, variable,
                        sequence, spaces, int, backtrackable)
import Set



-- Tokens:
-- OpenParen    := '('
-- CloseParen   := ')'
-- Quote        := '\''
-- Number       := [ '-' ] ( NonZeroDigit { Digit } | '0' )
-- Identifier   := IdChar { IdChar }
-- Digit        := '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' | '9'
-- NonZeroDigit := Digit \ '0'
-- IdChar       := Any \ Digit \ ')' \ '(' \ '\'' \ Whitespace
-- Whitespace   := '\n' | '\r' | ' '



type Token
  = OpenParen
  | CloseParen
  | Quote
  | Number Int
  | Identifier String


lexer : Parser (List Token)
lexer = sequence
  { start = ""
  , separator = ""
  , end = ""
  , spaces = spaces
  , item = lexToken
  , trailing = Parser.Optional
  } 


lexToken : Parser Token
lexToken = oneOf
  [ succeed OpenParen
    |. symbol "("
  , succeed CloseParen
    |. symbol ")" 
  , succeed Quote
    |. symbol "'" 
  , succeed Number
    |= backtrackable myInt
  , succeed Identifier
    |= myIdentifier
  ]


myIdentifier : Parser String
myIdentifier = variable
  { start = isIdentifierChar
  , inner = isIdentifierChar
  , reserved = Set.empty
  }


isIdentifierChar : Char -> Bool
isIdentifierChar c =
  String.contains (String.fromChar c) "0123456789()' \n\r" |> not
  -- Fuck tabs
  -- ~ John Elm, circa 20.19


myInt : Parser Int
myInt =
  oneOf
    [ succeed negate
        |. symbol "-"
        |= int
    , int
    ]

LispParser.elm ASCII text

module LispParser exposing (..)


import Lexer as L exposing (Token)


-- Syntax:
-- Program    := { Statement }
-- Statement  := MacroDef | FunDef | Expression
-- MacroDef   := 'macro:' Identifier Expression
-- FunDef     := 'fun:' Identifier Expression
-- Expression := Identifier | Number | '\'' Expression | ConsExpr
-- ConsExpr   := '(' { Expression } ')'


type AST
  = Variable String
  | Integer Int
  | Quoted AST
  | ConsList (List AST)


type Statement
  = MacroDef String AST
  | FunctionDef String AST
  | RawExpression AST


parse : List Token -> Result String (List Statement)
parse t = case t of
  [] -> Ok []
  L.Identifier "macro:" :: L.Identifier name :: tokens ->
    case parseExpr tokens of
      Ok (macro, ts) -> case parse ts of
        Ok stmts -> MacroDef name macro :: stmts |> Ok
        Err s -> Err s
      Err s -> Err s
  L.Identifier "fun:" :: L.Identifier name :: tokens ->
    case parseExpr tokens of
      Ok (function, ts) -> case parse ts of
        Ok stmts -> FunctionDef name function :: stmts |> Ok
        Err s -> Err s
      Err s -> Err s
  _ ->
    case parseExpr t of
      Ok (expr, ts) -> case parse ts of
        Ok stmts -> RawExpression expr :: stmts |> Ok
        Err s -> Err s
      Err s -> Err s


parseExpr : List Token -> Result String (AST, List Token)
parseExpr t = case t of
  L.Number x :: ts -> Ok (Integer x, ts)
  L.Identifier s :: ts -> Ok (Variable s, ts)
  L.Quote :: ts -> case parseExpr ts of
    Ok (expr, tokens) -> Ok (Quoted expr, tokens)
    Err s -> Err s
  L.OpenParen :: ts -> case consBuilder ts of
    Ok (asts, tokens) -> Ok (ConsList asts, tokens)
    Err s -> Err s
  L.CloseParen :: ts -> Err "Unexpected ')' encountered!"
  [] -> Err "Unxpected end of text!"


consBuilder : List Token -> Result String (List AST, List Token)
consBuilder t = case t of
  L.CloseParen :: ts -> Ok ([], ts)
  [] -> Err "Unclosed '('!"
  _ -> case parseExpr t of
    Err s -> Err s
    Ok (expr, ts) -> case consBuilder ts of
      Err s -> Err s
      Ok (asts, tokens) -> Ok (expr :: asts, tokens)

Main.elm ASCII text

module Main exposing (..)


import Interpretter as I exposing (InterpreterState, Environment, interpret)
import Lexer exposing (lexer)
import Parser as P exposing (DeadEnd, run)
import LispParser exposing (parse)
import Dict
import Std as S exposing (stdDefs, stdMacros)
import File
import File.Select as Select
import Browser
import Browser.Events exposing (onKeyDown)
import Html exposing (Html, text, div, br, button, form, textarea, input)
import Html.Events exposing (onClick, onInput)
import Html.Attributes exposing (value, type_)
import Task exposing (perform)
import Json.Decode as Json exposing (field, string, bool)


-- Main

main = Browser.element
  { init = init
  , update = update
  , view = view
  , subscriptions = always sub
  }


init : () -> ( Model, Cmd Msg )
init _ =
  ( { defs = stdDefs
    , macros = stdMacros
    , results = []
    , input = ""
    }, Cmd.none )


-- Model

type alias Model =
  { defs : Environment
  , macros : Environment
  , results : List String
  , input : String
  }


-- Controller

type Msg
  = Run String Bool
  | UpdateInput String
  | Import
  | ReadFile File.File
  | LoadFile String String



update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  let
      resultToString r = case r of
        Ok v -> I.valueToString v
        Err s -> s
  in case msg of
    Run code control ->
      if not control || code /= "Enter" then ( model, Cmd.none ) else
        case executor
          { defs = model.defs
          , macros = model.macros
          , result = []
          } model.input of
            Err s ->
              ( { model
                | results = ("> " ++ model.input)
                  :: s
                  :: model.results
                }, Cmd.none )
            Ok state ->
              ( { model
                | defs = state.defs
                , macros = state.macros
                , results = ("> " ++ model.input) ::
                            (List.map resultToString state.result
                             ++ model.results)
                , input = ""
                }, Cmd.none )
    UpdateInput s -> ( { model | input = s }, Cmd.none )
    Import -> ( model, Select.file ["text/*"] ReadFile )
    ReadFile f -> (model, File.toString f |> perform (File.name f |> LoadFile))
    LoadFile name source -> case executor
      { defs = model.defs
      , macros = model.macros
      , result = []
      } source of
        Err s ->
          ( { model
            | results = ("> Importing " ++ name)
              :: s
              :: model.results
            }, Cmd.none )
        Ok state ->
          ( { model
            | defs = state.defs
            , macros = state.macros
            , results = ("> Importing " ++ name)
                        :: (List.map resultToString state.result
                            ++ model.results)
            }, Cmd.none )


-- Subscriptions

sub : Sub Msg
sub = onKeyDown ( Json.map2 Run (field "key" string) (field "ctrlKey" bool) )

-- Code execution

executor : InterpreterState -> String -> Result String InterpreterState
executor state source =
  run lexer source |> Result.mapError deadEndsToString
  |> Result.andThen parse |> Result.map (interpret state)


deadEndsToString : List DeadEnd -> String
deadEndsToString = List.map (\end ->
  "Lexing error on line " ++ String.fromInt end.row
  ++ " column " ++ String.fromInt end.col ++ ":\n" ++
  ( case end.problem of
    P.Expecting s -> "Expected " ++ s ++ ". This should not happen."
    P.ExpectingInt -> "Expected an integer."
    P.ExpectingHex -> "Expected a hex number. This should not happen."
    P.ExpectingOctal -> "Expected an octal number. This should not happen."
    P.ExpectingBinary -> "Expected a binary number. This should not happen."
    P.ExpectingFloat ->
      "Expected a floating point number. This should not happen."
    P.ExpectingNumber -> "Expected a number. This should not happen."
    P.ExpectingVariable -> "Expected an identifier."
    P.ExpectingSymbol s -> "Expected '" ++ s ++ "'."
    P.ExpectingKeyword s -> "Expected '" ++ s ++ "'. This should not happen."
    P.ExpectingEnd -> "Expected end of text. This should not happen."
    P.UnexpectedChar -> "Unexpected character. This should not happen."
    P.Problem s -> "Problem: " ++ s ++ ". This should not happen."
    P.BadRepeat -> "Bad repeat! This should not happen." ) )
  >> String.join "\n\n"


-- View

view : Model -> Html Msg
view model =
  div []
  [ text "Ctrl+Enter to submit. Not styled. "
  , text "For help read the file attached with the source.", br [] []
  , button [ onClick Import ] [ text "Import file" ], br [] []
  , textarea [ value model.input, onInput UpdateInput ] []
  , div [] (List.map (text) model.results |> List.intersperse (br [] []))
  ]

Std.elm ASCII text

module Std exposing (..)


import Interpretter as I exposing (Function, Environment, Value, Skeleton)
import Dict


add : Environment -> Value -> Result String Value
add e a =
  let
      adder args = case args of
        I.Cons (I.Integer n) b -> adder b |> Result.map ((+) n)
        I.Null -> Ok 0
        _ -> Err ("'+' expected a list of integers, got "
                  ++ I.valueToString args)
  in adder a |> Result.map I.Integer


sub : Environment -> Value -> Result String Value
sub e args = case args of
  I.Cons (I.Integer a) (I.Cons (I.Integer b) _) -> Ok (I.Integer (a - b))
  I.Cons (I.Integer a) (I.Integer b) -> Ok (I.Integer (a - b))
  I.Cons (I.Integer a) I.Null -> Ok (I.Integer (-a))
  I.Integer a -> Ok (I.Integer (-a))
  _ -> Err ("'-' expected one or two integers, got "
            ++ I.valueToString args)


mul : Environment -> Value -> Result String Value
mul e a =
  let
      muler args = case args of
        I.Cons (I.Integer n) b -> muler b |> Result.map ((*) n)
        I.Null -> Ok 1
        _ -> Err ("'*' expected a list of integers, got "
                  ++ I.valueToString args)
  in muler a |> Result.map I.Integer


div : Environment -> Value -> Result String Value
div e args = case args of
  I.Cons (I.Integer a) (I.Cons (I.Integer b) _) -> Ok (I.Integer (a // b))
  I.Cons (I.Integer a) (I.Integer b) -> Ok (I.Integer (a // b))
  _ -> Err ("'/' expected two integers, got "
            ++ I.valueToString args)


mod : Environment -> Value -> Result String Value
mod e args = case args of
  I.Cons (I.Integer a) (I.Cons (I.Integer b) _) -> Ok (I.Integer (modBy b a))
  I.Cons (I.Integer a) (I.Integer b) -> Ok (I.Integer (modBy b a))
  _ -> Err ("'%' expected two integers, got "
            ++ I.valueToString args)


gt : Environment -> Value -> Result String Value
gt e args = case args of
  I.Cons (I.Integer a) (I.Cons (I.Integer b) _) ->
    if a > b then Ok (I.Integer a)
    else Ok I.Null
  I.Cons (I.Integer a) (I.Integer b) ->
    if a > b then Ok (I.Integer a)
    else Ok I.Null
  _ -> Err ("'>' expected two integers, got "
            ++ I.valueToString args)


eq : Environment -> Value -> Result String Value
eq e args = case args of
  I.Cons a (I.Cons b _) ->
    if a == b then Ok a
    else Ok I.Null
  _ -> Err ("'=' expected two arguments, got "
            ++ I.valueToString args)


lambda : Environment -> Value -> Result String Value
lambda env args =
  let
      skeletonize params = case params of
        I.Null -> Ok I.Wildcard
        I.Symbol s -> Ok (I.Capture s)
        I.Cons car cdr -> case skeletonize car of
          Err s -> Err s
          Ok carPattern -> case skeletonize cdr of
            Err s -> Err s
            Ok cdrPattern -> Ok (I.ConsPattern carPattern cdrPattern)
        _ -> Err ("Argument patterns must consist of symbols, conses and Nulls,"
                  ++ " instead got " ++ I.valueToString params)
  in case args of
    I.Cons params (I.Cons body _) ->
      skeletonize params
      |> Result.map (\x -> I.Fun (I.Closure env x body))
    _ -> Err ("lambda requires an argument pattern and body, instead got"
              ++ I.valueToString args)


cons : Environment -> Value -> Result String Value
cons env args = case args of
  I.Cons a (I.Cons b _) -> Ok (I.Cons a b)
  _ -> Err ("'cons' expected two arguments, got "
            ++ I.valueToString args)


carOp : Environment -> Value -> Result String Value
carOp env args = case args of
  I.Cons (I.Cons x _) _ -> Ok x
  _ -> Err ("'car' expected a cons cell, got "
            ++ I.valueToString args)


cdrOp : Environment -> Value -> Result String Value
cdrOp env args = case args of
  I.Cons (I.Cons _ x) _ -> Ok x
  _ -> Err ("'cdr' expected a cons cell, got "
            ++ I.valueToString args)


quote : Environment -> Value -> Result String Value
quote env args = case args of
  I.Cons x _ -> Ok (I.Quoted x)
  _ -> Err ("'quote' expected an argument, got "
            ++ I.valueToString args)


eval : Environment -> Value -> Result String Value
eval env args = case args of
  I.Cons x _ -> I.eval env x
  _ -> Err ("'eval' expected an argument, got "
            ++ I.valueToString args)


apply : Environment -> Value -> Result String Value
apply env args = case args of
  I.Cons fun params -> I.call env fun params
  _ -> Err ("'apply' expected arguments, got "
            ++ I.valueToString args)


ifNull : Environment -> Value -> Result String Value
ifNull env args = case args of
  I.Cons cond (I.Cons ifTrue (I.Cons ifFalse _)) ->
    if cond == I.Null then I.eval env ifTrue
    else I.eval env ifFalse
  _ -> Err ("'if-null' expected three, got "
            ++ I.valueToString args)


ifInteger : Environment -> Value -> Result String Value
ifInteger env args = case args of
  I.Cons cond (I.Cons ifTrue (I.Cons ifFalse _)) -> case cond of
    I.Integer _ -> I.eval env ifTrue
    _ -> I.eval env ifFalse
  _ -> Err ("'if-integer' expected three, got "
            ++ I.valueToString args)


ifSymbol : Environment -> Value -> Result String Value
ifSymbol env args = case args of
  I.Cons cond (I.Cons ifTrue (I.Cons ifFalse _)) -> case cond of
    I.Symbol _ -> I.eval env ifTrue
    _ -> I.eval env ifFalse
  _ -> Err ("'if-symbol' expected three, got "
            ++ I.valueToString args)


ifQuoted : Environment -> Value -> Result String Value
ifQuoted env args = case args of
  I.Cons cond (I.Cons ifTrue (I.Cons ifFalse _)) -> case cond of
    I.Quoted _ -> I.eval env ifTrue
    _ -> I.eval env ifFalse
  _ -> Err ("'if-quoted' expected three, got "
            ++ I.valueToString args)


ifCons : Environment -> Value -> Result String Value
ifCons env args = case args of
  I.Cons cond (I.Cons ifTrue (I.Cons ifFalse _)) -> case cond of
    I.Cons _ _ -> I.eval env ifTrue
    _ -> I.eval env ifFalse
  _ -> Err ("'if-cons' expected three, got "
            ++ I.valueToString args)


ifFun : Environment -> Value -> Result String Value
ifFun env args = case args of
  I.Cons cond (I.Cons ifTrue (I.Cons ifFalse _)) -> case cond of
    I.Fun _ -> I.eval env ifTrue
    _ -> I.eval env ifFalse
  _ -> Err ("'if-function' expected three, got "
            ++ I.valueToString args)


stdDefs : Environment
stdDefs = Dict.fromList
  [ ("+", I.Fun (I.Builtin add))
  , ("-", I.Fun (I.Builtin sub))
  , ("*", I.Fun (I.Builtin mul))
  , ("/", I.Fun (I.Builtin div))
  , ("%", I.Fun (I.Builtin mod))
  , (">", I.Fun (I.Builtin gt))
  , ("=", I.Fun (I.Builtin eq))
  , (".", I.Fun (I.Builtin cons))
  , ("car", I.Fun (I.Builtin carOp))
  , ("cdr", I.Fun (I.Builtin cdrOp))
  , ("quote", I.Fun (I.Builtin quote))
  , ("lambda", I.Fun (I.Builtin lambda))
  , ("eval", I.Fun (I.Builtin eval))
  , ("apply", I.Fun (I.Builtin apply))
  , ("if-symbol", I.Fun (I.Builtin ifSymbol))
  , ("if-integer", I.Fun (I.Builtin ifInteger))
  , ("if-quote", I.Fun (I.Builtin ifQuoted))
  , ("if-cons", I.Fun (I.Builtin ifCons))
  , ("if-function", I.Fun (I.Builtin ifFun))
  , ("if-null", I.Fun (I.Builtin ifNull))
  ]


stdMacros : Environment
stdMacros = Dict.empty

README.rst ASCII text

================================================================================
                                    Minor-L
================================================================================

Minor-L is a minimalist Lisp system made for `code guessing round 49`_. It
consists of several Elm source files that can be imported to use the language in
Elm, as well as the ``Main.elm`` file that joins them together and presents as a
crude web application.

.. _code guessing round 49: https://cg.esolangs.gay/49/


Web interface
=============

Minor-L comes with a crude web interface for running the code and evaluating
expressions. It consists of three sections:


Import button
-------------

This button lets you import source code from a text file on your computer. It
will run all the statements in the file as if they were entered from the text
box and print any errors or values of raw expressions to the feed. Any
definitions included in the file will enter the environment.


Textbox
-------

You can input code to be run here. It can contain any amount of statements, and
will be run when you press ``Ctrl`` + ``Enter`` (tested on Firefox). The code
will be executed up to the first error in definition, and any errors and values
of raw expressions will be reported in the feed.


Feed
----

Output of the executed code will be printed below the textbox. It will include
parsing and lexing errors, values of raw expressions, errors from raw
expressions, and errors from the first erroneous definition in a batch.


Language overview
=================

Minor-L, like most Lisps, has very simple syntax which translates in a
straightforward way to semantics.


Lexemes
-------

There are three kinds of lexemes in Minor-L: symbols, numbers and identifiers.
Whitespace is required only between two numbers or two identifiers to mark the
boundary.

* **Symbols** are single characters among ``'()``. They are used for literal
quoting and cons lists.

* **Numbers** consist of decimal digits, possibly prefixed by a ``-`` sign. They
indicate literal integers.

* **Identifiers** consist of any character that is not a symbol, digit or
whitespace. This means that care must be taken where an identifier is next to a
negative number: a whitespace may be necessary to disambiguate the parsing.


Expressions
-----------

Expressions in Minor-L follow a simple crammar::

  expression  := quoted | cons-list | literal
  quoted      := "'" expression
  cons-list   := "(" { expression } ")"
  literal     := number | identifier

Number and identifier tokens indicate literal integers and symbols.
Parenthesized lists indicate cons-lists of their contents, whith the special
case of empty list meaning the ``Null`` value. Quoted expressions are just that:
quoted expressions.

Minor-L expressions are pure functions of the environment: they don't interact
with anything outside the environment and don't change it. Order of evaluation
inside an expression doesn't matter, but keep in mind that it's eager so beware
of accidental infinite loops.


Program
-------

A program is a series of statemets. These can take one of three forms:

* **Macro definitions** start with the symbol ``macro:`` followed by another
  symbol and an expression. The symbol is then defined as a macro with the body
  being the value of the expression.

* **Function definitions** start with the symbol ``fun:`` followed by another
  symbol and an expression. The symbol is then defined as a function (actually
  any value) with the body being the value of the expression.

* **Raw expressions** are just expressions. They are evaluated and their values
  are reported, but they have no consequence to further evaluation.

All statements are processed in order, and definitions build up the environment
available for further code. Therefore direct recursion is not supported, and
order of evaluation of statements matters.


Evaluation
----------

Minor-L is a homoiconic language, which means that its code can be represented
as data, and any data can be treated as code (which will usually result in an
error). This is what executing each data type does:

* **Integers, Functions and Null** will just return themselves when executed.

* **Quoted expressions** will remove one layer of quoting and return the
  expression.

* **Symbols** will look up a value corresponding to them in the environment and
  return that. It's an error to evaluate an undefined symbol.

* **Cons cells** will evaluate each ``car`` in the list and then apply the first
  element to the rest.

Each main expression in every statement is evaluated once.


Application
-----------

Functions can be applied to arguments. If the function is one one of the
builtins it will do something specific to it. If instead it is a closure defined
in code it will match the argument list to the structure of its argument
pattern, capture values that correspond to symbols in the pattern and evaluate
its body in the environment it closed over extended by the newly captured
values.


Glossary
========

Functions in Minor-L come in two kinds. Builtins are defined in Elm source code,
are more powerful, and have access to the caller's environment. Closures can be
defined in Minor-L code and they close over the environment at the point of
their definition.


Builtins
--------

This is the list of builtin functions in Minor-L. They are defined in the
``Std.elm`` file.

``lambda`` : (*pattern* *body*)
  Captures the environment and returns a new closure with some argument
  *pattern* and some *body*. These values should usually be quoted.

``eval`` : (*expression*)
  Evaluates *expression*.

``apply`` : (*function* *arguments*)
  Applies *function* to *arguments*. Can be useful when the function requires
  unusual shape of arguments.

``.`` : (*car* *cdr*)
  Constructs a cons cell with some *car* and some *cdr*.

``car`` : (*cons*)
  Gets the car of a cons cell.

``cdr`` : (*cons*)
  Gets the cdr of a cons cell.

``quote`` : (*value*)
  Returns the value quoted.

``+`` : (*n...*)
  Returns the sum of its arguments. Errors if they are not all integers.

``-`` : (*n*) | (*a* *b*)
  Returns *n* negated or *b* subtracted from *a*.

``*`` : (*n...*)
  Returns the product of its arguments. Errors if they are not all integers.

``/`` : (*a* *b*)
  Returns *a* divided by *b*.

``%`` : (*a* *b*)
  Returns a value congruent to *a* modulo *b*.

``>`` : (*a* *b*)
  Returns *a* if *a* is greater than *b*, otherwise ``Null``.

``=`` : (*a* *b*)
  Returns *a* if *a* is the same as *b*, otherwise ``Null``.

``if-symbol`` : (*value* *if-yes* *if-no*)
  If *value* is a symbol evaluate *if-yes*, otherwise evaluate *if-no*. The
  latter two should usually be quoted expressions.

  Variants for other types: ``if-integer``, ``if-quote``, ``if-cons``,
  ``if-function`` and ``if-null`` work in a similar way.


Closures
--------

The language itself doesn't provide any more functions than the builtins, but
there's a ``core.mil`` file provided with some convenient functions and macros.

``id`` : (*x*)
  Returns *x*.

``dup`` : (*x*)
  Returns (*x* *x*).

``factorial`` : (*n*)
  Calculates the factorial of *n*.

``map`` : (*f* *list*)
  Applies function *f* to each element of *list*.

``foldl`` : (*f*:(*acc* *next*) *id* *list*)
  Folds the *list* from the left using *f*, providing the running result as
  *acc* and subsequent elements of *list* as *next*, with the initial running
  result *id*.

``foldr`` : (*f*:(*prev* *acc*) *id* *list*)
  Folds the *list* from the right using *f*, providing the running result as
  *acc* and subsequent elements of *list* as *next*, with the initial running
  result *id*.

``reverse`` : (*list*)
  Reverses the list.

``last`` : (*list*)
  Returns the last element of a non-empty list. Linear in terms of list length.

``but-last`` : (*list*)
  Cuts off the last element of the list. Linear in terms of list lenght.

``and`` : (*x...*)
  Returns ``0`` if none of the arguments are ``Null``, or ``Null`` if any are.

``or`` : (*x...*)
  Returns the last argument that is not ``Null``, or ``Null`` if there are none.

``traverse-tree`` : (*mapper* *reducer* *tree*)
  Traverses the cons *tree* running *mapper* on each leaf and *reducer* on each
  pair of branches.

``map-tree`` : (*mapper* *tree*)
  Runs *mapper* on each leaf of the *tree*. A special case of ``traverse-tree``
  with *reducer* equal to ``.``.

``reduce-tree`` : (*reducer* *tree*)
  Runs *reducer* on each pair of branches of *tree*. A special case of
  ``traverse-tree`` with *mapper* equal to ``id``.


Macros
------

The language itself doesn't provide any macros, but there's a ``core.mil`` file
provided with some convenient functions and macros.

``def`` : (*args* *body*)
  Quotes *args* and *body* and passes them to ``lambda``.

``def*`` : (*args* *body*)
  Like ``def`` but rearranges *args* such that the last argument captures all
  additional arguments.

``rec`` : (*self* *args* *body*)
  Defines a recursive function taking *args* and with *body* that uses *self*
  symbol for recursive calls.

``if`` : (*cond* *if-true* *if-false*)
  Rearranges branches and quotes them such that if *cond* evaluates to ``Null``
  then *if-false* is executed, and *if-true* is executed otherwise.

``let`` : ((*symbol* *value*)... *body*)
  Makes *body* evaluate in an environment where each given *value* is bound to
  its corresponding *symbol*. These bindings are also used in evaluating *value*
  expressions. *body* shouldn't be quoted.

core.mil ASCII text

macro: def
(lambda '(args body)
        '(. lambda (. (quote args) (. (quote body) ()))))


fun: id (def (x) x)


macro: if
(def (cond if-false if-true)
     (. if-null (. cond (. (quote if-true) (. (quote if-false) ())))))


fun: dup (def (x) (. x (. x ())))


macro: rec
(def (self args body)
   (. (. lambda (. ''(_rec)
      (. (quote (dup (. lambda (. ''(__rec)
        (. (quote (. '_rec (. (. lambda (. (quote args) (. (quote (. '(__rec __rec) args)) ())))
        ()))) ()))))) ())))
      (. (. lambda (. (quote (. self ())) (. (quote (. lambda (. (quote args) (.
      (quote body) ())))) ()))) ())))


fun: factorial
(rec factorial (x)
  (if (> x 1)
    (* x (factorial (- x 1)))
    1))


fun: map
(rec map (f list)
  (if-cons list
    '(. (f (car list)) (map f (cdr list)))
    '()))

fun: foldl
(rec foldl (f id list)
  (if-cons list
    '(foldl f (f id (car list)) (cdr list))
    'id))

fun: foldr
(rec foldr (f id list)
  (if-cons list
    '(f (car list) (foldr f id (cdr list)))
    'id))


fun: reverse (def (list) (foldl (def (l x) (. x l)) () list))

fun: last (def (list) (car (reverse list)))

fun: but-last (def (list) (reverse (cdr (reverse list))))


fun: traverse-tree
(rec traverse-tree (mapper reducer tree)
  (if-cons tree
    '(reducer
      (traverse-tree mapper reducer (car tree))
      (traverse-tree mapper reducer (cdr tree)))
    '(mapper tree)))

fun: map-tree (def (mapper tree) (traverse-tree mapper . tree))

fun: reduce-tree (def (reducer tree) (traverse-tree id reducer tree))


macro: def*
(def (args body)
  (. lambda
    (. (quote (foldr . (last args) (but-last args)))
      (. (quote body) ()))))


macro: let
(def args
  (foldr
    (def ((sym val) body)
      (. (. lambda (. (quote (. sym ())) (. (quote body) ())))
        (. val ())))
    (last args)
    (but-last args)))


fun: and
(def args
  (foldl
    (def (prev next) (if next prev next))
    0 args))

fun: or
(def args
  (foldl
    (def (prev next) (if next next prev))
    () args))

elm.json JSON text data

{
    "type": "application",
    "source-directories": [
        "src"
    ],
    "elm-version": "0.19.1",
    "dependencies": {
        "direct": {
            "elm/browser": "1.0.2",
            "elm/core": "1.0.5",
            "elm/file": "1.0.5",
            "elm/html": "1.0.0",
            "elm/json": "1.1.3",
            "elm/parser": "1.1.0"
        },
        "indirect": {
            "elm/bytes": "1.0.8",
            "elm/time": "1.0.0",
            "elm/url": "1.0.0",
            "elm/virtual-dom": "1.0.3"
        }
    },
    "test-dependencies": {
        "direct": {},
        "indirect": {}
    }
}

index.html ASCII text

entry #5

written by Palaiologos
submitted at 2023-12-05T20:30:15.861917+00:00
0 likes

guesses

Palaiologos (by IFcoltransG)
Palaiologos (by LyricLy)
Palaiologos (by taswelll)
Palaiologos (by olus2000)
Palaiologos (by luatic)
Palaiologos (by yui)
yui (by vspf)

comments 0

post a comment

cosmolisp.bz3 bzip3 compressed data, blocksize 1048576

entry #6

written by yui
submitted at 2023-12-04T18:20:24.114227+00:00
2 likes

guesses

IFcoltransG (by LyricLy)
IFcoltransG (by Palaiologos)
IFcoltransG (by vspf)
LyricLy (by taswelll)
taswelll (by IFcoltransG)
vspf (by olus2000)
yui (by luatic)

comments 0

post a comment

lisp.rs ASCII text

macro_rules! lisp {
    (($($a:tt)+) $($rest:tt)*) => {
        lisp!(@expand_ln $($a)+);
        $(lisp!($rest);)*
    };

    (($a:literal)) => { $a };

    (@expand_ln + $($t:tt)+) => { lisp!(@expand_op + $($t)+) };
    (@expand_ln - $($t:tt)+) => { lisp!(@expand_op - $($t)+) };
    (@expand_ln * $($t:tt)+) => { lisp!(@expand_op * $($t)+) };
    (@expand_ln = $($t:tt)+) => { lisp!(@expand_op == $($t)+) };
    (@expand_ln > $($t:tt)+) => { lisp!(@expand_op > $($t)+) };
    (@expand_ln < $($t:tt)+) => { lisp!(@expand_op < $($t)+) };

    (@expand_ln print $($a:tt)+) => {
        println!("{}", lisp!(@expand_args $($a)+))
    };
  
    (@expand_ln defun $name:ident ($($args:ident)+) $($t:tt)*) => {
        let $name = |$($args: isize),+| {
            $(;lisp!($t))*
        };
    };

    (@expand_ln defvar $name:ident $($val:tt)+) => {
        let mut $name = lisp!(@expand_arg $($val)+);
    };

    (@expand_ln setvar $name:ident $($val:tt)+) => { $name = lisp!(@expand_arg $($val)+); };

    (@expand_ln if ($($cond:tt)+) $(then)? ($($then:tt)+) $(else)? $(($($else:tt)+))?) => {
        if lisp!(@expand_ln $($cond)+) {
            lisp!(@expand_ln $($then)+)
        } else {
            $(lisp!(@expand_ln $($else)+))?
        }
    };

    (@expand_ln dotimes ($i:ident $($times:tt)+) $($t:tt)+) => {
        for $i in 0..lisp!(@expand_arg $($times)+) {
            lisp!($($t)+);
        }
    };

    (@expand_ln loop $(while)? ($($cond:tt)+) $(do)? $($t:tt)+) => {
        while lisp!(@expand_ln $($cond)+) {
            lisp!($($t)+);
        }
    };

    (@expand_ln return $($t:tt)+) => {
        return lisp!(@expand_arg $($t)+)
    };

    (@expand_ln $fn:ident $($args:tt)*) => {
        $fn($(lisp!(@expand_args $args)),*);
    };

    (@expand_arg $a:literal) => { $a };
    (@expand_arg $a:ident) => { $a };
    (@expand_arg ($($a:tt)+)) => { lisp!(@expand_ln $($a)+) };

    (@expand_args $a:literal $($rest:tt)*) => { $a $(lisp!(@expand_args $rest)),* };
    (@expand_args $a:ident $($rest:tt)*) => { $a $(lisp!(@expand_args $rest)),* };
    (@expand_args ($($n:tt)+) $($rest:tt)*) => { lisp!(@expand_ln $($n)+) $(lisp!(@expand_args $rest)),* };

    (@expand_op $op:tt $n:ident $($rest:tt)+) => { $n $op lisp!(@expand_op $op $($rest)+) };
    (@expand_op $op:tt $n:literal $($rest:tt)+) => { $n $op lisp!(@expand_op $op $($rest)+) };
    (@expand_op $op:tt ($($n:tt)+) $($rest:tt)+) => { lisp!(@expand_ln $($n)+) $op lisp!(@expand_op $op $($rest)+) };
    (@expand_op $op:tt $n:ident) => { $n };
    (@expand_op $op:tt $n:literal) => { $n };
    (@expand_op $op:tt ($($n:tt)+)) => { lisp!(@expand_ln $($n)+) };
}

pub(crate) use lisp;

main.rs ASCII text

mod lisp;
use crate::lisp::lisp;

fn main() {
    lisp!(
        (defun example (n1 n2 n3)
            (if (= n1 n2)
                (print "n1 equals n2"))
            (if (> n1 n3)
                (print "n1 is greater than n3")
                (print "n1 is less than or equal to n3"))
            (print (* n1 n2 n3))
        )

        (defvar funny 69)

        (example funny funny 42)
        (example 1 funny 3)

        (defun fib (n)
            (defvar i (- n 1))
            (defvar a 0)
            (defvar b 1)
            (defvar c (+ a b))
            (loop while (> i 0)
                (setvar a b)
                (setvar b c)
                (setvar c (+ a b))
                (setvar i (- i 1))
            )
            (return c)
        )

        (print "fib(8) is")
        (print (fib 8))

        (print "Counting to 5!")
        (dotimes (n 5)
            (print (+ n 1)))
    );
}

entry #7

written by LyricLy
submitted at 2023-12-27T07:10:01.300077+00:00
3 likes

guesses

IFcoltransG (by olus2000)
LyricLy (by IFcoltransG)
LyricLy (by luatic)
luatic (by vspf)
taswelll (by Palaiologos)
taswelll (by yui)
yui (by taswelll)

comments 1

IFcoltransG ¶

Interesting that the std imports aren't merged.

post a comment

dir src

core.rs ASCII text

use std::collections::HashMap;
use std::cell::RefCell;
use std::rc::Rc;
use crate::eval::{State, eval};
use crate::sexpr;
use crate::sexpr::{Sexpr, SexprData::*, nil};

fn eval_args(state: &mut State, args: &mut [Sexpr]) -> Result<(), String> {
    for arg in args {
        *arg = eval(state, arg.clone())?;
    }
    Ok(())
}

fn n_args<const N: usize>(args: Vec<Sexpr>) -> Result<[Sexpr; N], String> {
    let l = args.len();
    args.try_into().map_err(|_| format!("expected {} arguments, got {}", N, l))
}

fn car(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [p] = n_args(args)?;
    let Cons(x, _) = &*p.borrow_data() else { return Err(format!("{p} is not a pair")) };
    Ok(x.clone())
}

fn cdr(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [p] = n_args(args)?;
    let Cons(_, y) = &*p.borrow_data() else { return Err(format!("{p} is not a pair")) };
    Ok(y.clone())
}

fn set_car(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [mut p, v] = n_args(args)?;
    let Cons(ref mut x, _) = &mut *p.borrow_data_mut() else { return Err(format!("{p} is not a pair")) };
    *x = v;
    Ok(nil())
}

fn set_cdr(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [mut p, v] = n_args(args)?;
    let Cons(_, ref mut y) = &mut *p.borrow_data_mut() else { return Err(format!("{p} is not a pair")) };
    *y = v;
    Ok(nil())
}

fn cons(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [x, y] = n_args(args)?;
    Ok(Sexpr::new(Cons(x, y)))
}

fn quote(_: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    let [x] = n_args(args)?;
    Ok(x)
}

#[inline(always)]
fn lambda_core(do_eval: bool, state: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    if args.len() < 2 {
        return Err(format!("lambda takes at least 2 arguments, got {}", args.len()));
    }
    let mut args = args.into_iter();
    let mut argspec = args.next().unwrap();
    let mut expected_args = Vec::new();
    let mut rest = None;
    while *argspec.borrow_data() != Nil {
        match &*argspec.clone().borrow_data() {
            Cons(x, y) => if let Symbol(s) = &*x.borrow_data() {
                argspec = y.clone();
                expected_args.push(s.clone())
            } else {
                return Err(format!("{x} is not a symbol"));
            }
            Symbol(s) => {
                rest = Some(s.clone());
                break;
            }
            _ => return Err(format!("{argspec} is not a symbol or list of symbols")),
        }
    }

    let mut captures = state.scopes.clone();
    let our_capture = Rc::new(RefCell::new(HashMap::new()));
    captures.push(our_capture.clone());

    let captured_state = State { scopes: captures };
    let body: Vec<Sexpr> = args.collect();

    Ok(Sexpr::new(Function(Box::new(move |new_state, mut given_args| {
        if given_args.len() < expected_args.len() 
        || rest.is_none() && given_args.len() > expected_args.len() {
            return Err(format!("expected {} arguments, got {}", expected_args.len(), given_args.len()));
        }
        if do_eval {
            eval_args(new_state, &mut given_args)?;
        }
        let mut it = given_args.into_iter();
        for (x, y) in expected_args.iter().zip(it.by_ref()) {
            our_capture.borrow_mut().insert(x.clone(), y);
        }
        if let Some(ref rest) = rest {
            let mut given_rest = nil();
            for y in it.rev() {
                given_rest = Sexpr::new(Cons(y, given_rest));
            }
            our_capture.borrow_mut().insert(rest.clone(), given_rest);
        }
        for (i, part) in body.iter().enumerate() {
            let r = eval(&mut captured_state.clone(), part.clone())?;
            if i == body.len() - 1 {
                return Ok(r);
            }
        }
        unreachable!();
    }))))
}

fn lambda(state: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    lambda_core(true, state, args)
}

fn flambda(state: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    lambda_core(false, state, args)
}

fn define(state: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    if args.len() < 2 {
        return Err(format!("define takes at least 2 arguments, got {}", args.len()));
    }
    let mut args = args.into_iter();
    let spec = args.next().unwrap();
    let (name, to_assign) = match &*spec.borrow_data() {
        Cons(x, y) => if let Symbol(name) = &*x.borrow_data() {
            (name.clone(), lambda(state, std::iter::once(y.clone()).chain(args).collect())?)
        } else {
            return Err(format!("{x} is not a symbol"));
        }
        Symbol(name) => {
            let next_arg = args.next().unwrap();
            if args.next().is_some() {
                return Err("define should take only 2 arguments in this form".to_owned());
            }
            (name.clone(), eval(state, next_arg)?)
        },
        _ => return Err(format!("{spec} is not a symbol or list of symbols")),
    };
    state.scopes[state.scopes.len()-1].borrow_mut().insert(name, to_assign);
    Ok(nil())
}

fn set(state: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    let [x, y] = n_args(args)?;
    let Symbol(name) = &*x.borrow_data() else { return Err(format!("{x} is not a symbol")) };
    let v = eval(state, y)?;
    for scope in state.scopes.iter().rev() {
        let mut m = scope.borrow_mut();
        if let Some(target) = m.get_mut(name) {
            *target = v;
            return Ok(nil());
        }
    }
    Err(format!("name {name} is not defined"))
}

fn comparison(pred: impl FnOnce(i64, i64) -> bool, state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [x, y] = n_args(args)?;
    let &Integer(x) = &*x.borrow_data() else { return Err(format!("{x} is not an integer")) };
    let &Integer(y) = &*y.borrow_data() else { return Err(format!("{y} is not an integer")) };
    Ok(Sexpr::new(Integer(pred(x, y).into())))
}

fn lt(state: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    comparison(|x, y| x < y, state, args)
}

fn gt(state: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    comparison(|x, y| x > y, state, args)
}

fn le(state: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    comparison(|x, y| x <= y, state, args)
}

fn ge(state: &mut State, args: Vec<Sexpr>) -> Result<Sexpr, String> {
    comparison(|x, y| x >= y, state, args)
}

fn eq(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [x, y] = n_args(args)?;
    Ok(Sexpr::new(Integer((x == y).into())))
}

fn is(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [x, y] = n_args(args)?;
    Ok(Sexpr::new(Integer(x.is(&y).into())))
}

fn add(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let mut sum = 0;
    for n in args {
        let Integer(n) = &*n.borrow_data() else { return Err(format!("{n} is not an integer")) };
        sum += n;
    }
    Ok(Sexpr::new(Integer(sum)))
}

fn mul(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let mut prod = 1;
    for n in args {
        let Integer(n) = &*n.borrow_data() else { return Err(format!("{n} is not an integer")) };
        prod *= n;
    }
    Ok(Sexpr::new(Integer(prod)))
}

fn sub(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let mut nums = Vec::new();
    for n in args {
        let &Integer(n) = &*n.borrow_data() else { return Err(format!("{n} is not an integer")) };
        nums.push(n);
    }
    match &nums[..] {
        [] => Err("- takes at least one argument")?,
        [x] => Ok(Sexpr::new(Integer(-x))),
        [x, ys @ ..] => Ok(Sexpr::new(Integer(x - ys.iter().sum::<i64>()))),
    }
}

fn apply(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    if args.len() < 2 {
        return Err(format!("apply takes at least 2 arguments, got {}", args.len()));
    }
    let mut to_call = args.remove(0);
    let mut end = args.pop().unwrap();
    while *end.borrow_data() != Nil {
        match &*end.clone().borrow_data() {
            Cons(x, y) => {
                args.push(x.clone());
                end = y.clone();
            },
            _ => return Err(format!("{end} is not a proper list")),
        }
    }
    let Function(f) = &mut *to_call.borrow_data_mut() else { return Err(format!("can't apply non-procedure {}", to_call)); };
    f(state, args)
}

fn truthy(x: &Sexpr) -> bool {
    match &*x.borrow_data() {
        &Integer(n) => n != 0,
        Nil => false,
        _ => true,
    }
}

fn if_else(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    if args.len() < 2 || args.len() > 3 {
        return Err(format!("if takes 2 or 3 arguments, got {}", args.len()));
    }
    if args.len() == 2 {
        args.push(sexpr::read(&mut "'()").unwrap());
    }
    let mut args = args.into_iter();
    if !truthy(&eval(state, args.next().unwrap())?) {
        args.next();
    }
    eval(state, args.next().unwrap())
}

fn print(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [x] = n_args(args)?;
    println!("{x}");
    Ok(nil())
}

fn eval_prim(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [x] = n_args(args)?;
    eval(state, x)
}

fn read(state: &mut State, mut args: Vec<Sexpr>) -> Result<Sexpr, String> {
    eval_args(state, &mut args)?;
    let [] = n_args(args)?;
    let mut s = String::new();
    std::io::stdin().read_line(&mut s).map_err(|s| s.to_string())?;
    Ok(sexpr::read(&mut &s[..])?)
}

pub fn core_state() -> State {
    let mut prelude = HashMap::new();
    prelude.insert(String::from("car"), Sexpr::new(Function(Box::new(car))));
    prelude.insert(String::from("cdr"), Sexpr::new(Function(Box::new(cdr))));
    prelude.insert(String::from("set-car!"), Sexpr::new(Function(Box::new(set_car))));
    prelude.insert(String::from("set-cdr!"), Sexpr::new(Function(Box::new(set_cdr))));
    prelude.insert(String::from("set!"), Sexpr::new(Function(Box::new(set))));
    prelude.insert(String::from("cons"), Sexpr::new(Function(Box::new(cons))));
    prelude.insert(String::from("quote"), Sexpr::new(Function(Box::new(quote))));
    prelude.insert(String::from("lambda"), Sexpr::new(Function(Box::new(lambda))));
    prelude.insert(String::from("flambda"), Sexpr::new(Function(Box::new(flambda))));
    prelude.insert(String::from("+"), Sexpr::new(Function(Box::new(add))));
    prelude.insert(String::from("-"), Sexpr::new(Function(Box::new(sub))));
    prelude.insert(String::from("*"), Sexpr::new(Function(Box::new(mul))));
    prelude.insert(String::from("define"), Sexpr::new(Function(Box::new(define))));
    prelude.insert(String::from("apply"), Sexpr::new(Function(Box::new(apply))));
    prelude.insert(String::from("<"), Sexpr::new(Function(Box::new(lt))));
    prelude.insert(String::from("="), Sexpr::new(Function(Box::new(eq))));
    prelude.insert(String::from(">"), Sexpr::new(Function(Box::new(gt))));
    prelude.insert(String::from(">="), Sexpr::new(Function(Box::new(ge))));
    prelude.insert(String::from("<="), Sexpr::new(Function(Box::new(le))));
    prelude.insert(String::from("is?"), Sexpr::new(Function(Box::new(is))));
    prelude.insert(String::from("if"), Sexpr::new(Function(Box::new(if_else))));
    prelude.insert(String::from("print"), Sexpr::new(Function(Box::new(print))));
    prelude.insert(String::from("eval"), Sexpr::new(Function(Box::new(eval_prim))));
    prelude.insert(String::from("read"), Sexpr::new(Function(Box::new(read))));
    State::new(prelude)
}

eval.rs ASCII text

use crate::sexpr::{Sexpr, SexprData, SexprData::*};
use std::collections::HashMap;
use std::rc::Rc;
use std::cell::RefCell;

#[derive(Clone)]
pub struct State {
    // sorry not sorry for this garbage
    pub scopes: Vec<Rc<RefCell<HashMap<String, Sexpr>>>>,
}

impl State {
    pub fn new(prelude: HashMap<String, Sexpr>) -> Self {
        Self { scopes: vec![Rc::new(RefCell::new(prelude))] }
    }
}

pub type Function = Box<dyn Fn(&mut State, Vec<Sexpr>) -> Result<Sexpr, String>>;

fn parse_call(x: &SexprData) -> Option<(Sexpr, Vec<Sexpr>)> {
    let Cons(head, rest) = x else { return None };
    let mut rest = rest.clone();
    let mut args = Vec::new();
    while let Cons(arg, next_rest) = &*rest.clone().borrow_data() {
        args.push(arg.clone());
        rest = next_rest.clone();
    }
    if *rest.borrow_data() != Nil {
        return None;
    }
    Some((head.clone(), args))
}

pub fn eval(state: &mut State, expr: Sexpr) -> Result<Sexpr, String> {
    match &*expr.clone().borrow_data() {
        Integer(_) => Ok(expr),
        Symbol(s) => if let Some(v) = state.scopes.iter().rev().find_map(|map| map.borrow().get(&s[..]).cloned()) {
            Ok(v)
        } else {
            Err(format!("undeclared symbol {s}"))
        }
        e => if let Some((head, args)) = parse_call(e) {
            let r = eval(state, head)?;
            let Function(f) = &*r.borrow_data() else { return Err(format!("can't apply non-procedure {r}")); };
            f(state, args)
        } else {
            Err(format!("can't evaluate improper expr: {expr}"))
        }
    }
}

main.rs ASCII text

mod sexpr;
mod eval;
mod core;

fn run(mut s: &str) -> Result<(), String> {
    let s = &mut s;
    let mut state = core::core_state();
    loop { 
        let x = sexpr::read(s);
        if x == Err("unexpected end of stream") {
            break;
        }
        eval::eval(&mut state, x?)?;
    }
    Ok(())
}

fn main() {
    let s = std::fs::read_to_string(std::env::args().nth(1).expect("provide an argument")).unwrap();
    if let Err(e) = run(&s) {
        eprintln!("error: {e}");
    }
}

sexpr.rs ASCII text

use std::rc::Rc;
use std::cell::{RefCell, Ref, RefMut};
use std::fmt;
use crate::eval::Function;

pub enum SexprData {
    Cons(Sexpr, Sexpr),
    Nil,
    Symbol(String),
    Integer(i64),
    Function(Function),
}

impl PartialEq for SexprData {
    fn eq(&self, other: &Self) -> bool {
        use SexprData::*;
        match (self, other) {
            (Cons(x1, y1), Cons(x2, y2)) => x1 == x2 && y1 == y2,
            (Nil, Nil) => true,
            (Symbol(x), Symbol(y)) => x == y,
            (Integer(x), Integer(y)) => x == y,
            (Function(x), Function(y)) => &*x as *const _ == &*y as *const _,
            _ => false,
        }
    }
}

#[derive(PartialEq, Clone)]
pub struct Sexpr(Rc<RefCell<SexprData>>);

impl Sexpr {
    pub fn new(x: SexprData) -> Self {
        Self(Rc::new(RefCell::new(x)))
    }

    pub fn is(&self, other: &Self) -> bool {
        Rc::ptr_eq(&self.0, &other.0)
    }

    pub fn borrow_data(&self) -> Ref<SexprData> {
        self.0.borrow()
    }

    pub fn borrow_data_mut(&mut self) -> RefMut<SexprData> {
        self.0.borrow_mut()
    }
}

fn write_inner_conses(f: &mut fmt::Formatter<'_>, d: &SexprData) -> fmt::Result {
    let SexprData::Cons(x, y) = d else { return Ok(()) };
    match &*y.borrow_data() {
        SexprData::Nil => write!(f, "{x}")?,
        y@SexprData::Cons(_, _) => {
            write!(f, "{x} ")?;
            write_inner_conses(f, y)?;
        }
        _ => write!(f, "{x} . {y}")?,
    }
    Ok(())
} 

fn write_conses(f: &mut fmt::Formatter<'_>, d: &SexprData) -> fmt::Result {
    // I hate this language
    'top: {
        let SexprData::Cons(x, y) = d else { break 'top };
        let SexprData::Cons(y, z) = &*y.borrow_data() else { break 'top };
        if *z.borrow_data() != SexprData::Nil { break 'top };
        let SexprData::Symbol(s) = &*x.borrow_data() else { break 'top };
        if s != "quote" { break 'top };
        return write!(f, "'{y}");
    }
    write!(f, "(")?;
    write_inner_conses(f, d)?;
    write!(f, ")")
}

impl fmt::Display for Sexpr {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        match &*self.0.borrow() {
            x@(SexprData::Nil | SexprData::Cons(_, _)) => write_conses(f, x),
            SexprData::Symbol(s) => write!(f, "{s}"),
            SexprData::Integer(n) => write!(f, "{n}"),
            SexprData::Function(_) => write!(f, "<(a procedure)>"),
        }
    }
}

impl fmt::Debug for Sexpr {
    fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
        write!(f, "{self}")
    }
}

static mut NIL: usize = 0;

pub fn nil() -> Sexpr {
    unsafe {
        // HAHAHAHAHAHAHA
        if NIL == 0 {
            NIL = Rc::into_raw(Sexpr::new(SexprData::Nil).0) as usize;
        }
        let nil = NIL as *const _;
        Rc::increment_strong_count(nil);
        Sexpr(Rc::from_raw(nil))
    }
}

enum Token {
    Dot,
    Quote,
    Left,
    Right,
    Symbol(String),
    Integer(i64),
}

fn is_special(c: char) -> bool {
    c == '(' || c == ')' || c.is_whitespace()
}

fn next_token(s: &mut &str) -> Option<Token> {
    *s = s.trim_start();
    while s.starts_with(';') {
        *s = s.trim_start_matches(|c| c != '\n').trim_start();
    }

    if s.is_empty() {
        return None;
    }
    for (token, kind) in [('(', Token::Left), (')', Token::Right), ('\'', Token::Quote)] {
        if let Some(r) = s.strip_prefix(token) {
            *s = r;
            return Some(kind);
        }
    }
    // dots are special and can be the start of identifiers
    if let Some(r) = s.strip_prefix('.') {
        if r.starts_with(is_special) {
            *s = r;
            return Some(Token::Dot);
        }
    }
    // god this is stupid
    let i = s.find(is_special).unwrap_or(s.len());
    let word = &s[0..i];
    let r = match word.parse() {
        Ok(n) => Token::Integer(n),
        Err(_) => Token::Symbol(word.to_owned()),
    };
    *s = &s[i..];
    Some(r)
}

pub fn read(s: &mut &str) -> Result<Sexpr, &'static str> {
    Ok(Sexpr::new(match next_token(s) {
        None => return Err("unexpected end of stream"),
        Some(Token::Dot) => return Err("unexpected dot"),
        Some(Token::Right) => return Err("unexpected close parenthesis"),
        Some(Token::Symbol(s)) => SexprData::Symbol(s),
        Some(Token::Integer(n)) => SexprData::Integer(n),
        Some(Token::Quote) => {
            let inner = read(s)?;
            let quote = Sexpr::new(SexprData::Symbol(String::from("quote")));
            SexprData::Cons(quote, Sexpr::new(SexprData::Cons(inner, nil())))
        }
        Some(Token::Left) => {
            let mut items = Vec::new();
            let mut end = nil();
            loop {
                // peek
                let save = *s;
                match next_token(s) {
                    None => return Err("unexpected end of stream in list"),
                    Some(Token::Dot) => {
                        if items.is_empty() {
                            return Err("unexpected dot at start of list");
                        }
                        end = read(s)?;
                        let Some(Token::Right) = next_token(s) else { return Err("expected close paren after expr following dot") };
                        break;
                    }
                    Some(Token::Right) => break,
                    _ => {
                        *s = save;
                        items.push(read(s)?);
                    },
                }
            }
            for item in items.into_iter().rev() {
                end = Sexpr::new(SexprData::Cons(item, end));
            }
            return Ok(end);
        }
    }))
}

Cargo.toml ASCII text

[package]
name = "plan"
version = "0.1.0"
edition = "2021"

[dependencies]

README.md ASCII text

# plan

Welcome to plan, a simple Lisp inspired by Scheme.

Build with `cargo build --release` or install with `cargo install --path .`.
Invoke with `plan file` to run `file`, run `plan repl.plan` for a REPL, or read `learnplan.plan` to learn the language. 

learnplan.plan ASCII text

; Where X=plan

; Based on Scheme, plan is a simple Lisp designed for code guessing #49.

; Single line comments start with semicolons.
; There are no multiline comments.

;;;-----------------------------------------------------------------------------
;;; 1. Primitive datatypes and operators
;;;-----------------------------------------------------------------------------

; plan is homoiconic, meaning that the data types used for programming are the
; same as those that make up the source code.

; Familiar types are here, and quoting does what you expect:
0                 ; integers
'a                ; symbols
'(1 . 0)          ; cons cells
'()               ; nil
'(1 2 3)          ; lists (which are just made of cons and nil)
+                 ; procedures

; There are no floats, rationals, booleans, strings, or vectors.
; There is also no "void" type (nil is used instead)

; Function application and basic math
(+ 1 2)           ; => 3
(- 3 2)           ; => 1
(- 3)             ; => -3
(* 2 2)           ; => 4
; There is no division

;;;-----------------------------------------------------------------------------
;;; 2. Functions and definitions
;;;-----------------------------------------------------------------------------

; define makes variables
(define x 1)
x                 ; => 1

; set! modifies variables. It doesn't work if the variable hasn't already been
; defined in the current scope.
(set! x (+ x 1))
x                 ; => 2

; define makes functions, which close over their environment
(define (f y) (set! x (+ x y)) x)
(f 1)             ; => 3
(f 2)             ; => 5

; It's syntactic sugar for lambda, which makes anonymous functions
(define f (lambda (x) (+ x 1)))

; There is no let. you can implement it yourself as an fexpr in terms of lambda.

;;;-----------------------------------------------------------------------------
;;; 3. Data manipulation
;;;-----------------------------------------------------------------------------

; You have car, cdr, set-car!, set-cdr!, and cons, and they do what you think
; they do.
(define x '(1 2 3))
(car x)            ; => 1
(set-car! x 4)
(car x)            ; => 4

; If you need anything else, define it yourself.

;;;-----------------------------------------------------------------------------
;;; 4. Comparison
;;;-----------------------------------------------------------------------------

; The integers 1 and 0 are used as the "canonical" booleans
; '() and 0 are the only falsy values; everything else is truthy

; = implements deep equality for all types
(= '(0 0) '(0 0))  ; => 1

; is? implements "identity" equality
(is? '(0) '(0))    ; => 0
(define x '(0))
(is? x x)          ; => 1

; < > >= <= work as normal, but only on integers
(< 0 1)            ; => 1

; There is no boolean logic. Either define it yourself or use these alternatives:
; and => *
; or  => +
; not => = 0

;;;-----------------------------------------------------------------------------
;;; 5. Control Flow
;;;-----------------------------------------------------------------------------

; For conditions, if is all you have
(if 1 'yes 'no)    ; => yes
(if 0 'yes)        ; => ()

; If you want cond or begin or something, write it yourself as an fexpr in terms
; of if.

; For looping, recursion is all you have
(define (factorial n)
  (if (= n 0)
    1
    (* n (factorial (- n 1)))))

;;;-----------------------------------------------------------------------------
;;; 6. Metaprogramming
;;;-----------------------------------------------------------------------------

; eval is here
(eval '(+ 1 2))    ; => 3

; plan has no traditional macros or special forms, but function arguments are
; not necessarily evaluated before calling. it is the function's responsibility
; to evaluate arguments. for instance, the built-in function quote returns its
; argument without evaluating it.

; functions created with lambda or define always evaluate their arguments.
; to create one that does not, use flambda
(define lambdax (flambda (e) (lambda (x) (eval e))))
(define f (lambdax (* x 2)))
(f 5)              ; => 10

;;;-----------------------------------------------------------------------------
;;; 7. The rest of it
;;;-----------------------------------------------------------------------------

; Display values with print
(print 'what's_your_name)

; Read values with read
(define name (read))
(print 'hello_there)
(print name)
(print '!)

; Use apply to "unpack" a list into a function's arguments
(apply + '(1 2 3)) ; => 6

; Make a function's parameters an improper list for "rest args" behavior
(define (list . x) x)
(list 1 2 3)       ; => (1 2 3)

repl.plan ASCII text

(define (loop)
  (print (eval (read)))
  (loop))
(loop)

entry #8

written by vspf
submitted at 2023-12-17T05:15:23.212807+00:00
1 like

guesses

IFcoltransG (by taswelll)
LyricLy (by olus2000)
vspf (by IFcoltransG)
vspf (by LyricLy)
vspf (by luatic)
vspf (by yui)
yui (by Palaiologos)

comments 0

post a comment

entrrui.py ASCII text, with CRLF line terminators

import urllib.request,tarfile,os,random,re
b = urllib.request.urlopen("https://cg.esolangs.gay/49.tar.bz2").read()
with open("hentai.txt", "wb") as binary_file:
    binary_file.write(b)
a = tarfile.open(name="hentai.txt", mode='r:bz2')
e = str(random.randint(0,10**10))
a.extractall(e)
a.close()
b = os.listdir(e+"/49")
f=[]
g=[]
h=[]
for i in b:
    c = os.listdir(e+"/49/"+i)
    print(c)
    if "entrrui.py" in c:
        continue
    if len(c) == 1 and bool(c[0].endswith(".py")):
        f += [i]
    elif len(c) == 1 and "." in c[0]:
        if c[0].index(".") not in (0,len(c[0])-1):
            g += [i]
    
    else:
        h += [i]
print(f,g,h)
exit()
path = e+"/49/"
if f:
    p = random.choice(f)
    path += p + "/" + os.listdir(e+"/49/"+p)[0]
    d = open(path,"r")
    w = d.read()
    d.close()
    exec(w)
elif g:
    p = random.choice(g)
    path += p + "/" + os.listdir(e+"/49/"+p)[0]
    d = open(path,"r")
    w = d.read()
    d.close()
    print("run this cuz i ain know how:\n")
    print(w)
else:
    P = urllib.request.urlopen("https://www.biostat.wisc.edu/~annis/creations/PyLisp/lisp.py").read()
    exec(P)

code guessing, round #49 (completed)

specification

results

entries

entry #1

post a comment

entry #2

post a comment

entry #3

post a comment

entry #4

post a comment

entry #5

post a comment

entry #6

post a comment

entry #7

post a comment

entry #8

post a comment