interpreter: removed the outdated tree-walk interpreter

.woodpecker/publish.yaml

@@ -0,0 +1,21 @@
+when:
+  event: [push, cron, pull_request, manual]
+
+steps:
+  - name: Build Nightly Artifact
+    image: ocaml/opam:debian-11-ocaml-5.4
+    commands:
+      - opam install . --deps-only
+      - opam exec -- dune build
+      - mkdir -p dist
+      - opam exec -- dune install --prefix=$(pwd)/dist
+
+      - tar czvf ollisp-nightly-amd64.tar.gz -C dist .
+  - name: Publish to Gitea
+    image: curlimages/curl
+    environment:
+      GITEA_TOKEN:
+        from_secret: package_token
+    commands:
+      - curl -v --user "$CI_REPO_OWNER:$GITEA_TOKEN" --upload-file ollisp-nightly-amd64.tar.gz $CI_FORGE_URL/api/packages/$CI_REPO_OWNER/generic/olisp/nightly/ollisp-nightly-amd64.tar.gz?duplicate_upgrade=true
+  

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2026 Emin Arslan
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

bin/comp.ml

@@ -1,23 +1,4 @@
 
-open Parser.Ast;;
-
-let p = Printf.sprintf
-
-let rec dbg_print = function
-  | LSymbol s -> p "%s" s
-  | LCons (a, LNil) -> p "%s)" (dbg_print_start a)
-  | LCons (a, b) -> p "%s %s" (dbg_print_start a) (dbg_print b)
-  | LNil -> p "()"
-  | LInt i -> p "%d" i
-  | LDouble d -> p "%f" d
-  | LString s -> p "%s" s
-
-and dbg_print_start = function
-  | LCons (_, _) as l -> p "(%s" (dbg_print l)
-  | _ as x -> dbg_print x
-
-
-
 let def = Parser.parse_str "(define (f)
                              (let ((x 5))
                               (if t (set! x (+ x 1)))))
@@ -28,9 +9,6 @@ let def = Parser.parse_str "(define (f)
                              ((> 1 2) 0)
                              ((> 3 2) 3)
                              (t -1))";;
-let desugared = List.map Compiler.Sugar.desugar def
-let () = List.iter (fun x -> Printf.printf "%s\n" (dbg_print_start x) ) desugared
-let () = print_newline ()
 
 let ( let* ) = Result.bind;;
 let e =

bin/dune

@@ -1,10 +1,4 @@
-(executable
- (name inter)
- (public_name ollisp-inter)
- (libraries str unix interpreter)
- (package ollisp))
-
 (executable
  (name comp)
  (public_name ollisp)
- (libraries str unix compiler interpreter))
+ (libraries str unix compiler))

bin/inter.ml

@@ -1,31 +0,0 @@
-open Interpreter.Ast;;
-open Printf;;
-open Interpreter;;
-open Env;;
-open Eval;;
-
-let () = Stdlib.init_default_env ()
-
-let rec repl env c =
-  let () = printf ">>> "; Out_channel.flush Out_channel.stdout; in
-  match In_channel.input_line c with
-  | None -> ()
-  | Some "exit" -> ()
-  | Some l ->
-    try
-      let vals = (read_from_str l) in
-      (* dbg_print_all vals; *)
-      pretty_print_all (eval_all env vals);
-      Out_channel.flush Out_channel.stdout;
-      repl env c
-    with
-    | Invalid_argument s ->
-      printf "%s\nResuming repl\n" s;
-      repl env c
-    | Parser.Parse.Error ->
-      printf "Expression '%s' couldn't be parsed, try again\n" l;
-      repl env c
-;;
-
-
-let () = repl (make_env ()) (In_channel.stdin)

doc/env.md

@@ -0,0 +1,210 @@
+This document holds my design notes for lexical and global environments
+for this compiler. I have not yet named the language.
+
+# Closures
+
+The environment system implements flat closures.
+When a closure is created at runtime, all free variables
+it uses are packaged as part of the function object, then the function
+body uses a GetFree instruction to get those free variables by an index.
+
+(Free variables are propagated from inner closures outwards. This is necessary,
+as this also handles multiple-argument functions gracefully.)
+
+```scheme
+(let ((a 10))
+  (print (+ a 5)))
+```
+
+This code will be compiled as a lambda that takes a single parameter and executes
+the body `(print (+ a 5))`, which is called immediately with the value 10.
+
+The compiler tries to perform symbol resolution on expressions in the body of the
+let as well, however it sees no other expressions creating further scopes.
+
+Since there are two free symbols in this code (`+` and `print`), and the surrounding
+environment does not have these two symbols defined locally, both of these symbols
+will be resolved to their global definitions directly.
+
+Now let's examine a classic example of closures:
+
+```scheme
+(define (adder x)
+  (lambda (y) (+ x y)))
+```
+
+The adder function takes an argument x, and creates returns a function that adds x
+to its argument.
+
+This is implemented by a compiler pass that resolves symbols. Starting from top-level
+expressions, it scans downwards, noting every free symbol. A free symbol is one
+that is used in an expression, yet has no value defined locally in that expression.
+In other words, its value must come from the surrounding scope.
+
+In this example, the adder function has a symbol x that is a part of its function definition.
+This is clearly not a free variable. However, examining the inner lambda expression,
+we can see that it uses y (which is not free) and x. The value of x is not defined
+as part of the lambda expression, so it must be free.
+
+The compiler, seeing this, notes that the inner lambda has a free variable `x`, and a parameter
+`y`. Thus, the lambda has 1 free variable and 1 parameter. This means the closure object will have
+a code pointer along with an array of length 1 forming the storage for the free variable(s).
+The compiler compiles the body of the lambda such that every occurance of `x` is replaced
+with code to get free variable #0 from the current closure. (`y` is, naturally, parameter #0).
+Otherwise, no special handling is necessary.
+
+The inner lambda has no other expressions creating further scopes, so the compiler
+knows it has hit the deepest scope in the expression, and starts scanning outwards once again.
+
+Scanning outwards, the compiler sees that there is a defined symbol x, and in the scope
+of this definition, a lambda expression that uses a free symbol named x is used. The
+compiler matches these, and compiles the lambda expression (as in, the value that the lambda
+expression will evaluate to) such that it creates a closure object: a pair of code pointer
+pointing to the already compiled body, and an array of length 1 containing the current
+value of x.
+
+This newly created value represents the closure. As you might notice, the current value
+of x has been copied into the closure object. The closure is now returned, and the
+scope of `adder` is destroyed. The closure object survives.
+
+Note: in actuality, the outer `adder` function itself is also a closure. The inner
+lambda actually has *two* free variables: `+` is also a symbol, and its value is not
+defined in the body of the lambda. Since `adder` also doesn't define it, the free symbol
+is propagated outwards, and adder also accesses it as a free variable. The compiler
+(when propagating free symbols) eventually reaches the global environment, and
+resolves these free symbols to their global definitions.
+
+All global symbols are late-bound. Once the free symbol is propagated outwards to the global
+definition, the compiler must notice this and insert an instruction to get the
+value of a global symbol.
+
+Thus, the following will raise an error at runtime:
+
+```
+(define (adder x)
+  (lambda (y) (+ x y)))
+(set! '+ 5)
+; + now equals 5.
+(adder 5 5)
+```
+
+Since `5` is not a function, it cannot be called, and this will raise an error.
+
+## Note on boxing
+
+Closure conversion makes some situations a bit tricky.
+
+```
+(let ((x 10))
+  (let ((f (lambda () x))) ;; f captures x
+    (set! x 20)            ;; we change local x
+    (f)))                  ;; does this return 10 or 20?
+```
+
+In this case, instead of x being copied directly into the closure, a
+reference to its value is copied into the closure. This is usual in
+most schemes and lisps.
+
+In fact, you can even treat these as mutable state:
+
+```
+(define (make-counter)
+ (let ((count 0))
+  (lambda ()
+    (set! count (+ count 1))
+    count)))
+```
+
+So a closure can capture not just the value of a symbol, but also a
+reference to it. This reference survives the end of the `make-counter`
+function.
+
+## Note on currying
+
+Because this language is actually a curried variant of lisp/scheme, the
+above function could also be written like this:
+
+```scheme
+(define (adder x y) (+ x y))
+```
+
+or, even like this:
+
+```scheme
+(define adder +)
+```
+
+... since the built-in `+` function is also already curried. In fact, the entire
+language is curried. All function calls are (or behave as if they were) unary.
+The function call syntax `(f x y)` is actually treated as `((f x) y)` by the
+compiler.
+
+## Note on syntax
+
+I am using more or less regular Scheme syntax in this document. However, this is
+potentially subject to change. I have not decided on what the official syntax
+should be like. I am using Scheme syntax simply because I think it is fairly clean,
+but some changes might make sense in the future as the semantics of this language
+deviate greatly from Scheme's.
+
+## Note on performance
+
+This design document may raise concerns of performance. If everything above is
+truly set in stone, then it seems obvious that there should be a performance
+penalty.
+
+As written, this design requires a basic addition like `(+ 1 2)` to allocate a
+closure object after all. No matter how fast OCaml's minor heap may be
+(and it is plenty fast, to be fair), that is not going to go well in a tight loop. 
+
+These are valid concerns, and I am currently leaving these problems to my future
+self.
+
+Optimizing multiple-argument functions is actually fairly straightforward (or
+it looks easy, at least), however I want to first make sure the language
+has consistent semantics. A slow language is better than no language, after all.
+So I intend to add the facilities necessary for these optimizations into the
+compiler at a later point.
+
+## Global Definitions
+
+Global definitions get a separate section because they're mostly straightforward.
+
+Any symbol defined through a top-level `define` form is made globally available
+after the definition form. More accurately, the symbol is present in the program
+before the define is reached, however it will be bound to a dummy value until
+it is accessed.
+
+This behaviour is proposed for the purpose of allowing mutually
+recursive definitions without issue, however please note that this is not yet certain,
+because this design comes with the tradeoff that errors involving symbols accessed
+before the point they are supposed to be defined can only be detected at runtime.
+
+To illustrate the problems this could cause:
+
+```
+(define b (+ a 10))
+(define a 5)
+```
+
+This is pretty clearly an error - yet the compiler cannot, as proposed, determine
+this. In the future, further passes over the source code could be added to scan
+for such issues, or a differentiator between top-level function and variable
+definitions to prevent this.
+
+Notably, this problem does not occur for function definitions. In fact, the following
+is perfectly fine despite looking a bit similar:
+
+```
+(define (b) (+ a 10))
+(define a 5)
+```
+
+Generally any symbol appearing in the body of a function, will only be compiled
+to access that symbol. The symbol is only accessed once the function is called.
+Thus, you can create mutually recursive functions at the top level with no issue.
+
+The body of the definition is only executed once the `define` form is reached.
+Thus, definitions with side effects will execute exactly in the order they
+appear in the source.
+

dune-project

@@ -1,5 +1,7 @@
 (lang dune 3.7)
 (using menhir 2.1)
+(generate_opam_files true)
 
 (package
- (name ollisp))
+ (name ollisp)
+ (depends menhir))

lib/compiler/compilation.ml

@@ -1,2 +0,0 @@
-
-

lib/compiler/core_ast.ml

@@ -16,7 +16,6 @@ type expression =
   | Var of string
   | Apply of expression * expression
   | Lambda of string * expression
-  | LetRec of (string * expression) list * expression
   | If of expression * expression * expression
   | Set of string * expression
   | Begin of expression list
@@ -46,6 +45,7 @@ and make_apply f args =
     | arg :: [] -> Apply (f, arg)
     | arg :: args -> aux (Apply (f, arg)) args
   in aux f args
+
 (* desugars this...
   (let ((x 5) (y 4)) (f x y))
   ... into this...
@@ -58,6 +58,17 @@ and make_let bs body =
        Apply (Lambda (s, aux rest), e)
     | [] -> of_body body in
   aux bs
+
+(* The Core AST does not feature a letrec node. Instead, we desugar letrecs further
+   into a let that binds each symbol to nil, then `set!`s them to their real value
+   before running the body.
+ *)
+and make_letrec bs exprs =
+  let tmp_bs = List.map (fun (s, _) -> (s, Literal Nil)) bs in
+  let setters = List.fold_right (fun (s, e) acc -> (Set (s, e)) :: acc) bs [] in
+  let body = Begin ((List.rev setters) @ exprs) in
+  List.fold_right (fun (s, e) acc -> Apply (Lambda (s, acc), e)) tmp_bs body
+
 (* We convert a body into a regular letrec form.
    A body is defined as a series of definitions followed by a series
    of expressions. The definitions behave exactly as a letrec, so
@@ -70,8 +81,7 @@ and of_body : Syntactic_ast.body -> expression = function
   | (defs, exprs) ->
      let exprs = List.map of_expr exprs in
      let defs = List.map pair_of_def defs in
-     let b = Begin exprs in
+     make_letrec defs exprs
-     LetRec (defs, b)
 
 (* TODO: currently this ignores the "optional" part of the lambda list,
    fix this *)
@@ -90,7 +100,7 @@ and of_expr : Syntactic_ast.expr -> expression = function
   | Var x -> Var x
   | Lambda (ll, b) -> make_lambda (of_ll ll) b
   | Let (bindings, b) -> make_let bindings b
-  | LetRec (bindings, b) -> LetRec (List.map pair_of_binding bindings, of_body b)
+  | LetRec (bindings, b) -> make_letrec (List.map pair_of_binding bindings) [(of_body b)]
   | Cond (clauses) -> 
      List.fold_right
        (fun (e1, e2) acc -> If (e1, e2, acc))

lib/compiler/scope_analysis.ml

@@ -0,0 +1,104 @@
+
+
+module SymbolTable = Map.Make(String);;
+
+let ( let* ) = Result.bind
+let traverse = Util.traverse
+
+(* literals are not modified. *)
+type literal = Core_ast.literal
+
+(* Note:
+   all symbol accesses are replaced with either a local or global access.
+   Local accesses a symbol in the local scope.
+   Global accesses a symbol in the global scope.
+
+   Lambda expressions are stripped of the symbol name of their single parameter.
+   This name is not needed at runtime, as all symbol accesses will be resolved
+   into an index into either the local scope linked list or the global symbol table.
+
+   Set is also split into its global and local versions, just like Var. 
+
+   The rest aren't modified at all.
+ *)
+type expression =
+  | Literal of literal
+  | Local of int
+  | Global of int
+  | Apply of expression * expression
+  | Lambda of expression
+  | If of expression * expression * expression
+  | SetLocal of int * expression
+  | SetGlobal of int * expression
+  | Begin of expression list
+
+
+(* extract all defined global symbols, given the top-level expressions
+   and definitions of a program
+
+   The returned table maps symbol names to unique integers, representing
+   an index into a global array where the values of all global symbols will
+   be kept at runtime.
+ *)
+let extract_globals (top : Core_ast.top_level list) =
+  let id_counter = (ref (-1)) in
+  let id () =
+    id_counter := !id_counter + 1; !id_counter in
+  let rec aux tbl = function
+    | [] -> tbl
+    | Core_ast.Define (sym, _) :: rest ->
+       aux (SymbolTable.add sym (id ()) tbl) rest
+    | Expr _ :: rest ->
+       aux tbl rest
+  in aux SymbolTable.empty top
+
+(* The current lexical scope is simply a linked list of entries,
+   and each symbol access will be resolved as an access to an index
+   in this linked list. The symbol names are erased before runtime.
+   During this analysis we keep the lexical scope as a linked list of
+   symbols, and we find the index by traversing this linked list.
+ *)
+
+let resolve_global tbl sym =
+  match SymbolTable.find_opt sym tbl with
+  | Some x -> Ok (Global x)
+  | None -> Error ("symbol " ^ sym ^ " is not defined!")
+
+let resolve_lexical tbl env sym =
+  let rec aux counter = function
+    | [] -> resolve_global tbl sym
+    | x :: _ when String.equal x sym -> Ok (Local counter)
+    | _ :: rest -> aux (counter + 1) rest
+  in aux 0 env
+
+let resolve_symbol tbl env sym =
+  resolve_lexical tbl env sym
+
+let resolve_set tbl env sym expr =
+  let* sym = resolve_symbol tbl env sym in
+  match sym with
+  | Local i -> Ok (SetLocal (i, expr))
+  | Global i -> Ok (SetGlobal (i, expr))
+  | _ -> Error "resolve_set: symbol resolution returned something invalid."
+
+let rec analyze tbl current = function
+  | Core_ast.Literal s -> Ok (Literal s)
+  | Var sym -> resolve_symbol tbl current sym
+  | Set (sym, expr) ->
+     let* inner = analyze tbl current expr in
+     resolve_set tbl current sym inner
+  | Lambda (s, body) ->
+     let* body = (analyze tbl (s :: current) body) in
+     Ok (Lambda body)
+  | Apply (f, e) ->
+     let* f = analyze tbl current f in
+     let* e = analyze tbl current e in
+     Ok (Apply (f, e))
+  | If (test, pos, neg) ->
+     let* test = analyze tbl current test in
+     let* pos = analyze tbl current pos in
+     let* neg = analyze tbl current neg in
+     Ok (If (test, pos, neg))
+  | Begin el ->
+     let* body = traverse (analyze tbl current) el in
+     Ok (Begin body)

lib/compiler/sugar.ml

@@ -1,170 +0,0 @@
-
-
-(* In this module we handle syntax sugar, i.e. simple built-in transformations
-   on source code.
-
-   Examples:
-   (define (f x) ...) = (define f (lambda (x) ...))
- *)
-
-open Parser.Ast
-
-let rec sexpr_to_list = function
-  | LCons (a, b) -> a :: (sexpr_to_list b)
-  | LNil -> []
-  | _ -> failwith "Not proper list!"
-let rec list_to_sexpr = function
-  | a :: b -> LCons (a, list_to_sexpr b)
-  | [] -> LNil
-
-let rec sexpr_map f = function
-  | LCons (a, b) -> LCons (f a, sexpr_map f b)
-  | LNil -> LNil
-  | _ -> failwith "Not proper list!!!"
-
-(* This MUST be called after function definitions have been desugared,
-   i.e. desugar_define_functions has been called
- *)
-let rec collect_definitions = function
-  | LCons (LCons (LSymbol "define", LCons (LSymbol _ as var, LCons (value, LNil))), rest) ->
-     let (defs, rest) = collect_definitions rest in
-     LCons (LCons (var, LCons (value, LNil)), defs), rest
-  | rest -> LNil, rest
-
-(* Uses collect_definitions to rewrite a lambda body's (define) forms
-   into letrec
-   see desugar_internal_define
- *)
-let make_letrec body =
-  let (defs, rest) = collect_definitions body in
-  match defs with
-  | LNil -> rest
-  | _ -> LCons (LCons (LSymbol "letrec", LCons (defs, rest)), LNil)
-
-(* (define (f ...) ...)
-   into
-   (define f (lambda (...) ...))
-   
- *)
-let rec desugar_define_function = function
-  | LCons (LSymbol "define", LCons (LCons (LSymbol _ as sym, args), body)) ->
-     let body = sexpr_map desugar_define_function body in
-     let lamb = LCons (LSymbol "lambda", LCons (args, body)) in
-     let def = LCons (LSymbol "define", LCons (sym, LCons (lamb, LNil))) in
-     def
-  | LCons (_, _) as expr ->
-     sexpr_map desugar_define_function expr 
-  | expr -> expr
-
-(* A lambda form's body must be a sequence of definitions, followed by
-   expressions to be evaluated.
-   This desugar phase rewrites the definitions (which must be at the start
-   of the lambda body) into a letrec form.
-
-   Example:
-   (lambda ()
-     (define (f) (display "hi"))
-     (f)
-     (f))
-   into:
-   (lambda ()
-     (letrec
-       ((f (lambda () (display "hi"))))
-       (f) (f)))  
- *)
-let rec desugar_internal_define = function
-  | LCons (LSymbol "lambda", LCons (args, body)) ->
-     LCons (LSymbol "lambda", LCons (args, (make_letrec body)))
-  | LCons (_, _) as expr ->
-     sexpr_map desugar_internal_define expr
-  | expr -> expr
-
-(* Turn bodies of lambdas and letrec's *)
-let rec beginize = function
-  | LCons (LSymbol "letrec" as sym, LCons (args, body))
-  | LCons (LSymbol "lambda" as sym, LCons (args, body)) ->
-     let body = beginize body in
-     let body = (match body with
-     | LCons (_, LCons (_, _)) as b ->
-        LCons (LCons (LSymbol "begin", b), LNil)
-     | _ -> body) in
-     LCons (sym, LCons (args, body))
-  | LCons (_, _) as expr ->
-     sexpr_map beginize expr
-  | expr -> expr
-
-(* These are helper functions for the logical and/or desugars. *)
-let make_single_let sym value body =
-  let val_list = LCons (sym, LCons (value, LNil)) in
-  let full_list = LCons (val_list, LNil) in
-  list_to_sexpr
-    [LSymbol "let"; full_list; body]
-
-let make_if cond t e =
-  list_to_sexpr
-    [LSymbol "if"; cond; t; e]
-
-let make_letif sym value cond t e =
-  make_single_let sym value
-    (make_if cond t e)
-
-(*
-  (or a b)
-  turns into
-  (let ((__generated_or1 a))
-   (if __generated_or1
-    __generated_or1
-    (let ((__generated_or2 b))
-     (if __generated_or2
-       __generated_or2
-       ()))))
- *)
-let rec desugar_logical_or = function
-  | LCons (LSymbol "or", LCons (f, rest)) ->
-     let sym = LSymbol (Gensym.gensym "or") in
-     let f = desugar_logical_or f in
-     let rest = LCons (LSymbol "or", rest) in
-     make_letif sym f sym sym (desugar_logical_or rest)
-  | LCons (LSymbol "or", LNil) ->
-     LNil (* TODO: Change this when/if you add #t/#f *)
-  | LCons (_, _) as expr ->
-     sexpr_map desugar_logical_or expr
-  | expr -> expr
-
-let rec desugar_logical_and = function
-  | LCons (LSymbol "and", LCons (first, rest)) ->
-     let sym = LSymbol (Gensym.gensym "and") in
-     let first = desugar_logical_and first in
-     let rest = LCons (LSymbol "and", rest) in
-     make_letif sym first sym (desugar_logical_and rest) sym
-  | LCons (LSymbol "and", LNil) ->
-     LSymbol "t" (* TODO: change this when/if you add #t/#f *)
-  | LCons (_, _) as expr ->
-     sexpr_map desugar_logical_and expr
-  | expr -> expr
-
-let rec cond_helper = function
-  | LCons (LCons (condition, then_), rest) ->
-     (* we need to desugar recursively, here as well. *)
-     let condition = desugar_cond condition in 
-     let then_ = desugar_cond then_ in
-     make_if condition (LCons (LSymbol "begin", then_)) (cond_helper rest)
-  | LNil -> LNil
-  | _ -> failwith "improper cond!" 
-
-and desugar_cond = function
-  | LCons (LSymbol "cond", (LCons (_, _) as conditions)) ->
-     cond_helper conditions
-  | LCons (_, _) as expr ->
-     sexpr_map desugar_cond expr
-  | expr -> expr
-     
-
-let desugar x =
-  x
-  |> desugar_define_function
-  |> desugar_internal_define
-  |> beginize
-  |> desugar_logical_or
-  |> desugar_logical_and
-  |> desugar_cond

lib/compiler/syntactic_ast.ml

@@ -34,13 +34,7 @@ type top_level =
 
 (* we use result here to make things nicer *)
 let ( let* ) = Result.bind
-let traverse f l =
+let traverse = Util.traverse
-  let rec aux acc = function
-    | x :: xs ->
-       let* result = f x in
-       aux (result :: acc) xs
-    | [] -> Ok (List.rev acc) in
-  aux [] l
 let map = List.map
 
 

lib/compiler/util.ml

@@ -0,0 +1,9 @@
+let ( let* ) = Result.bind
+
+let traverse f l =
+  let rec aux acc = function
+    | x :: xs ->
+       let* result = f x in
+       aux (result :: acc) xs
+    | [] -> Ok (List.rev acc) in
+  aux [] l

lib/interpreter/ast.ml

@@ -1,142 +0,0 @@
-
-(* This is different from the lisp_ast data returned by the parser!
-   We will first need to translate that into this in order to use it.
-   This representation includes things that can only occur during runtime,
-   like the various kinds of functions and macros.
-
-   Additionally, since this is an interpreter, macros tend to be a little
-   awkward in that they behave exactly like the macro gets expanded just
-   before the result gets executed. This is different from the compiled
-   behaviour where the macro is evaluated at compile time.
-
-   Though of course, with the dynamic nature of lisp, and its capability
-   to compile more code at runtime, there will naturally be complications.
- *)
-type lisp_val = 
-  | LInt of int 
-  | LDouble of float 
-  | LCons of lisp_val * lisp_val
-  | LNil
-  | LSymbol of string
-  | LString of string
-  
-  (* a builtin function is expressed as a name and the ocaml function
-  that performs the operation. The function should take a list of arguments.
-  generally, builtin functions should handle their arguments directly,
-  and eval forms in the environment as necessary. *)
-  | LBuiltinFunction of string * (environment -> lisp_val -> lisp_val)
-  | LBuiltinSpecial of string * (environment -> lisp_val -> lisp_val)
-  (* a function is a name, captured environment, a parameter list, and function body. *)
-  | LFunction of string * environment * lisp_val * lisp_val
-  | LLambda of environment * lisp_val * lisp_val
-  (* a macro is exactly the same as a function, with the distinction
-     that it receives all of its arguments completely unevaluated
-   *)
-  | LMacro of string * environment * lisp_val * lisp_val
-  | LUnnamedMacro of environment * lisp_val * lisp_val
-  | LQuoted of lisp_val
-(* the environment type needs to be defined here, as it is mutually
- recursive with lisp_val *)
-and environment = (string, lisp_val) Hashtbl.t list
-
-(* It is clear that we need some primitives for working with the lisp
-   data structures.
-
-   For example, the LCons and LNil values, together, form a linked list.
-   This is the intended form of all source code in lisp, yet because
-   we are using our own implementation of a linked list instead of
-   ocaml's List, we can not use its many functions.
-
-   It may be tempting to switch to a different implementation.
-   Remember however, that classic lisp semantics allow for the
-   CDR component of a cons cell (the part that would point to the
-   next member) to be of a type other than the list itself.
- *)
-
-let reverse vs =
-  let rec aux prev = function
-    | LNil -> prev
-    | LCons (v, next) -> aux (LCons (v, prev)) next
-    | _ -> invalid_arg "cannot reverse non-list!"
-  in aux LNil vs
-
-let map f =
-  let rec aux accum = function
-    | LNil -> reverse accum
-    | LCons (v, next) -> aux (LCons (f v, accum)) next
-    | _ -> invalid_arg "cannot map over non-list!"
-  in aux LNil
-
-let reduce init f =
-  let rec aux accum = function
-    | LNil -> accum
-    | LCons (v, next) -> aux (f accum v) next
-    | _ -> invalid_arg "cannot reduce over non-list!"
-  in aux init
-
-let rec dbg_print_list =
-  let pf = Printf.sprintf in
-  function
-  | LCons (v, LNil) -> pf "%s" (dbg_print_one v)
-  | LCons (v, rest) -> (pf "%s " (dbg_print_one v)) ^ (dbg_print_list rest)
-  | v -> pf ". %s" (dbg_print_one v)
-
-and dbg_print_one v =
-  let pf = Printf.sprintf in
-  match v with
-  | LInt x ->  pf "<int: %d>" x
-  | LSymbol s -> pf "<symbol: '%s'>" s
-  | LString s -> pf "<string: '%s'>" s
-  | LNil -> pf "<nil>"
-  | LCons _ -> pf "<list: (%s)>" (dbg_print_list v) 
-  | LDouble d -> pf "<double: %f>" d
-  | LBuiltinSpecial (name, _)
-  | LBuiltinFunction (name, _) -> pf "<builtin: %s>" name
-  | LLambda (_, args, _) -> pf "<unnamed function, lambda-list: %s>"
-    (dbg_print_one args)
-  | LFunction (name, _, args, _) -> pf "<function: '%s' lambda-list: %s>" 
-    name (dbg_print_one args)
-  | LUnnamedMacro (_, args, _) -> pf "<unnamed macro, lambda-list: %s>"
-    (dbg_print_one args)
-  | LMacro (name, _, args, _) -> pf "<macro '%s' lambda-list: %s>"
-    name (dbg_print_one args)
-  | LQuoted v -> pf "<quote: %s>" (dbg_print_one v)
-  (*| _ -> "<Something else>"*)
-
-let rec pretty_print_one v =
-  let pf = Printf.sprintf in
-  match v with
-  | LInt x -> pf "%d" x
-  | LSymbol s -> pf "%s" s
-  | LString s -> pf "\"%s\"" s
-  | LNil -> pf "()"
-  | LCons (a, b) -> pf "(%s)" (dbg_print_list (LCons (a,b)))
-  | LDouble d -> pf "%f" d
-  | LQuoted v -> pf "'%s" (pretty_print_one v)
-  | LBuiltinSpecial _
-  | LBuiltinFunction _ 
-  | LLambda _
-  | LFunction _
-  | LUnnamedMacro _
-  | LMacro _  -> dbg_print_one v
-
-let pretty_print_all vs =
-  let pr v = Printf.printf "%s\n" (pretty_print_one v) in
-  List.iter pr vs
-
-let dbg_print_all vs =
-  let pr v = Printf.printf "%s\n" (dbg_print_one v) in
-  List.iter pr vs
-
-
-let rec convert_one = function
-  | Parser.Ast.LInt x -> LInt x
-  | Parser.Ast.LDouble x -> LDouble x
-  | Parser.Ast.LNil -> LNil
-  | Parser.Ast.LString s -> LString s
-  | Parser.Ast.LSymbol s -> LSymbol s
-  | Parser.Ast.LCons (a, b) -> LCons (convert_one a, convert_one b)
-
-
-let read_from_str s =
-  List.map convert_one (Parser.parse_str s)

lib/interpreter/dune

@@ -1,4 +0,0 @@
-(library
- (name interpreter)
- (libraries parser)
- (package ollisp))

lib/interpreter/env.ml

@@ -1,38 +0,0 @@
-open Ast
-(* the type `environment` is defined in Ast *)
-
-let default_env: environment = [Hashtbl.create 1024];;
-
-let copy (env : environment) : environment =
-  List.map Hashtbl.copy env
-
-let make_env () = copy default_env
-
-let new_lexical (env : environment) : environment = 
-  let h = Hashtbl.create 16 in
-  h :: env
-
-let set_local (env : environment) (s : string) (v : lisp_val) : unit =
-  match env with
-  | [] -> ()
-  | e1 :: _ -> Hashtbl.replace e1 s v
-
-let rec update (env : environment) s v =
-  match env with
-  | [] -> ()
-  | e1 :: erest ->
-     match Hashtbl.find_opt e1 s with
-     | None -> update erest s v
-     | Some _ -> Hashtbl.replace e1 s v
-
-let rec get_root (env : environment) =
-  match env with
-  | [] -> raise (Invalid_argument "Empty environment passed to env_root!")
-  | e :: [] -> e
-  | _ :: t -> get_root t
-
-let set_global (env : environment) s v =
-  Hashtbl.replace (get_root env) s v
-
-let set_default s v =
-  set_global default_env s v

lib/interpreter/eval.ml

@@ -1,76 +0,0 @@
-open Ast;;
-
-
-(* the type annotations are unnecessary, but help constrain us from a
-potentially more general function here *)
-let rec eval_sym (env: environment) (s: string) =
-  match env with
-  | [] -> raise (Invalid_argument (Printf.sprintf "eval_sym: symbol %s has no value in current scope" s))
-  | e :: rest ->
-    match Hashtbl.find_opt e s with
-    | None -> eval_sym rest s
-    | Some v -> v
-
-let rec eval_one env = function
-  | LSymbol s -> eval_sym env s
-  | LCons (func, args) -> eval_call env (eval_one env func) args
-  | LQuoted v -> v
-  | v -> v (* All other forms are self-evaluating *)
-
-(* Evaluate a list of values, without evaluating the resulting
-function or macro call. Since macros and functions inherently
-look similar, they share a lot of code, which is extracted here *)
-and eval_list env l =
-  match l with
-  | LNil -> LNil
-  | LCons (a, b) -> LCons (eval_one env a, eval_list env b)
-  | _ -> raise (Invalid_argument "eval_list: cannot process non-list")
-
-and eval_body env body =
-  match body with
-  | LNil -> LNil
-  | LCons (form, LNil) -> eval_one env form
-  | LCons (form, next) -> ignore (eval_one env form); eval_body env next
-  | _ -> LNil
-
-and bind_args env = function
-  | (LNil, LNil) -> ()
-  | (LSymbol s, v) -> Env.set_local env s v
-  | (LCons (LSymbol hl, tl), LCons (ha, ta)) -> Env.set_local env hl ha; bind_args env (tl, ta)
-  | _ -> invalid_arg "cannot bind argument list for function"
-
-and eval_apply args = function
-  | LLambda (e, l, b)
-  | LFunction (_, e, l, b) ->
-    let lexical_env = Env.new_lexical e in
-    bind_args lexical_env (l, args);
-    eval_body lexical_env b
-  | LUnnamedMacro (e, l, b)
-  | LMacro (_, e, l, b) ->
-    let lexical_env = Env.new_lexical e in
-    bind_args lexical_env (l, args);
-    eval_body lexical_env b
-  | v ->
-    invalid_arg ("Non-macro non-function value passed to eval_apply "
-        ^ dbg_print_one v)
-
-and eval_call env func args =
-  match func with
-  | LBuiltinSpecial (_, f) -> f env args
-  | LBuiltinFunction (_, f) -> f env (eval_list env args)
-  (* The function calls don't happen in the calling environment,
-     so it makes no sense to pass env to a call. *)
-  | LLambda _
-  | LFunction _ -> eval_apply (eval_list env args) func
-  (* Macros are the same, they just return code that *will* be evaluated
-  in the calling environment *)
-  | LUnnamedMacro _
-  | LMacro _ -> eval_one env (eval_apply args func)
-  | v -> raise (Invalid_argument 
-                  (Printf.sprintf "eval_apply: cannot call non-function object %s" (dbg_print_one v)))
-
-let eval_all env vs =
-  let ev v = eval_one env v in
-  List.map ev vs;;
-
-

lib/interpreter/stdlib.ml

@@ -1,204 +0,0 @@
-open Ast;;
-
-(* I feel like the more I get into functional programming, the more insane my code
-   becomes. What the fuck is this? why do I have a set of functions that combine
-   binary operators over an arbitrarily long list? I have like. 4 operators. None
-   of this matters.
-
-   But it's just so... beautiful.
- *)
-let mathop_do_once int_op float_op = function
-  | (LDouble v1, LDouble v2) -> LDouble (float_op v1 v2)
-  | (LDouble v1, LInt v2) -> LDouble (float_op v1 (float_of_int v2))
-  | (LInt v1, LDouble v2) -> LDouble (float_op (float_of_int v1) v2)
-  | (LInt v1, LInt v2) -> LInt (int_op v1 v2)
-  | _ -> invalid_arg "invalid arguments to mathematical operator"
-
-let mathop_do_once_curried int_op float_op =
-  let f = mathop_do_once int_op float_op in
-  fun x -> fun y -> f (x, y)
-
-let mathop_reduce fi ff init vs =
-  let curried = mathop_do_once_curried fi ff in
-  reduce init curried vs
-
-let cast_int_to_double = function
-  | LInt x -> LDouble (float x)
-  | LDouble x -> LDouble x
-  | _ -> invalid_arg "can't cast_int_to_double!"
-
-let add _ vs =
-  mathop_reduce (+) (+.) (LInt 0) vs
-let sub _ = function
-  | LCons (x, LNil) -> ((mathop_do_once (-) (-.)) (LInt 0, x))
-  | LCons (x, rest) -> mathop_reduce (-) (-.) x rest
-  | _ -> invalid_arg "invalid argument list passed to (-)"
-let mul _ vs =
-  mathop_reduce ( * ) ( *. ) (LInt 1) vs
-let div _ vs =
-  let div_one = mathop_do_once ( / ) ( /. ) in
-  match vs with
-    (* (/ x) is equal to 1 / x  *)
-  | LCons (x, LNil) -> div_one (LDouble 1., cast_int_to_double x)
-  | LCons (x, LCons (y, LNil)) -> div_one (cast_int_to_double x, y)
-  | _ -> invalid_arg "invalid argument list passed to (/)"
-
-let rem _ = function
-  | LCons (x, LCons (y, LNil)) ->
-     mathop_do_once (mod) (mod_float) (cast_int_to_double x, cast_int_to_double y)
-  | _ -> invalid_arg "invalid argument list passed to (rem)"
-
-
-let car _ = function
-  | LCons (a, _) -> a
-  | _ -> invalid_arg "car: non-cons"
-let cdr _ = function
-  | LCons (_, d) -> d
-  | _ -> invalid_arg "cdr: non-cons"
-let cons _ a b = LCons (a, b)
-let lisp_list _ vs = vs
-
-(* builtin function that updates an existing binding *)
-let lisp_set env sym v =
-  match sym with
-  | LSymbol s -> Env.update env s v; v
-  | _ -> invalid_arg ("cannot set non-symbol " ^ dbg_print_one sym)
-let lambda env = function
-  | LCons (l, body) ->
-    LLambda (env, l, body)
-  | args -> invalid_arg ("invalid args to fn! " ^ (dbg_print_one args)) 
-let defn env = function
-  | LCons (LSymbol s, LCons (l, body)) ->
-     let f = LFunction (s, env, l, body) in
-     Env.set_global env s f; f
-  | args -> invalid_arg ("cannot define function! " ^ (dbg_print_one args))
-
-let lambda_macro env = function
-  | LCons (l, body) -> LUnnamedMacro (env, l, body)
-  | args -> invalid_arg ("invalid args to fn-macro! " ^ (dbg_print_one args)) 
-let defmacro env = function
-  | LCons (LSymbol s, LCons (l, body)) ->
-     let f = LMacro (s, env, l, body) in
-     Env.set_global env s f; f
-  | args -> invalid_arg ("cannot define macro! " ^ (dbg_print_one args))
-
-
-let lisp_not _ = function
-  | LCons (LNil, LNil) -> LSymbol "t"
-  | _ -> LNil;;
-
-(* This only creates a *local* binding, contained to the body given. *)
-let bind_local env = function
-  | LCons (LSymbol s, LCons (v, body)) ->
-    let e = Env.new_lexical env in
-    Env.set_local e s (Eval.eval_one env v);
-    Eval.eval_body e body
-  | _ -> invalid_arg "invalid argument to bind-local"
-
-(* special form that creates a global binding *)
-let lisp_define env = function
-  | LCons (LSymbol s, LCons (v, LNil)) ->
-     let evaluated = Eval.eval_one env v in
-     Env.set_global env s evaluated;
-     evaluated
-  | _ -> invalid_arg "invalid args to def"
-
-let lisp_if env = function
-  | LCons (cond, LCons (if_true, LNil)) ->
-    (match Eval.eval_one env cond with
-     | LNil -> LNil
-     | _ -> Eval.eval_one env if_true)
-  | LCons (cond, LCons (if_true, LCons (if_false, LNil))) ->
-    (match Eval.eval_one env cond with
-     | LNil -> Eval.eval_one env if_false
-     | _ -> Eval.eval_one env if_true)
-  | _ -> invalid_arg "invalid argument list passed to if!"
-
-
-open Env;;
-
-
-let bf s f = s, LBuiltinFunction (s, f)
-let bf1 s f =
-  let aux e = function
-    | LCons (v, LNil) -> f e v
-    | _ -> invalid_arg ("invalid argument to " ^ s)
-  in bf s aux
-let bf2 s f =
-  let aux e = function
-    | LCons (v1, LCons (v2, LNil)) -> f e v1 v2
-    | _ -> invalid_arg ("invalid argument to " ^ s)
-  in bf s aux
-
-let sp s f = s, LBuiltinSpecial (s, f)
-let sp1 s f =
-  let aux e = function
-    | LCons (v, LNil) -> f e v
-    | _ -> invalid_arg ("invalid argument to " ^ s)
-  in sp s aux
-let sp2 s f =
-  let aux e = function
-    | LCons (v1, LCons (v2, LNil)) -> f e v1 v2
-    | _ -> invalid_arg ("invalid argument to " ^ s)
-  in sp s aux
- 
-
-let add_builtins bs =
-  List.iter (fun (s, f) -> set_default s f) bs
-
-(*
-(def defn
-  (fn-macro (name lm . body)
-    (list 'def name (cons 'fn (cons lm body)))))
-(def defmacro
-  (fn-macro (name lm . body)
-    (list 'def name (cons 'fn-macro (cons lm body)))))
- *)
-
-let init_script =
-"
-(defmacro setq (sym val)
- (list 'set (list 'quote sym) val))
-(defmacro letfn (sym fun . body)
- (cons 'let-one (cons sym (cons '() (cons (list 'setq sym fun) body)))))
-
-(defn mapcar (f l)
- (if l))
-(defn filter (f l)
-   (letfn helper
-       (fn (l acc)
-         (if (nil? l) acc (helper (cdr l) (if (f (car l)) (cons (car l) acc) acc))))
-     (helper l '())))
-";;
-
-let init_default_env () =
-  add_builtins [
-      bf "+" add; bf "-" sub;
-      bf "*" mul; bf "/" div;
-      bf1 "car" car;
-      bf1 "cdr" cdr;
-      bf2 "cons" cons;
-      bf "rem" rem;
-      bf2 "set" lisp_set;
-      bf "list" lisp_list;
-      bf "nil?" lisp_not;
-      bf "not" lisp_not;
-      
-      sp "fn" lambda;
-      sp "defn" defn;
-      sp "fn-macro" lambda_macro;
-      sp "defmacro" defmacro;
-      sp "let-one" bind_local;
-      sp "def" lisp_define;
-      sp1 "quote" (fun _ x -> x);
-      sp "if" lisp_if;
-    ];
-
-  (*let () = add_builtin "print" lisp_prin *)
-
-  (* I know this looks insane. please trust me.
-     Idea: maybe put this in a file instead of putting
-     literally the entire standard library in a constant string
-   *)
-  ignore (Eval.eval_all default_env (read_from_str init_script));
-  ()

ollisp.opam

@@ -0,0 +1,21 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+depends: [
+  "dune" {>= "3.7"}
+  "menhir"
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]