├── Dist ├── Examples │ ├── Sudoku.lisp │ └── fibonacci.lisp ├── Lisp.exe └── LispEngine.dll ├── Lisp ├── .gitignore ├── Lisp.sln ├── Lisp │ ├── Examples │ │ ├── Sudoku.lisp │ │ └── fibonacci.lisp │ ├── Lisp.csproj │ ├── Program.cs │ ├── Properties │ │ └── AssemblyInfo.cs │ └── REPL.lisp ├── LispEngine │ ├── Bootstrap │ │ ├── Append.cs │ │ ├── Arithmetic.cs │ │ ├── Builtins.cs │ │ ├── Builtins.lisp │ │ ├── Builtins.lisp~ │ │ ├── IO.lisp │ │ ├── Library.lisp │ │ ├── Reader.cs │ │ ├── StandardEnvironment.cs │ │ └── SymbolFunctions.cs │ ├── Core │ │ ├── Apply.cs │ │ ├── Begin.cs │ │ ├── BinaryFunction.cs │ │ ├── CallCC.cs │ │ ├── CoreForms.cs │ │ ├── DebugFunctions.cs │ │ ├── Define.cs │ │ ├── Env.cs │ │ ├── EqualFunctions.cs │ │ ├── Eval.cs │ │ ├── ExecuteWithErrorTranslator.cs │ │ ├── Lambda.cs │ │ ├── LexicalBinder.cs │ │ ├── Log.cs │ │ ├── Macro.cs │ │ ├── Quote.cs │ │ ├── Set.cs │ │ ├── UnaryFunction.cs │ │ └── VectorFunctions.cs │ ├── Datums │ │ ├── AbstractVisitor.cs │ │ ├── Atom.cs │ │ ├── Datum.cs │ │ ├── DatumExtensions.cs │ │ ├── DatumHelpers.cs │ │ ├── DatumVisitor.cs │ │ ├── Null.cs │ │ ├── Pair.cs │ │ ├── Symbol.cs │ │ └── Vector.cs │ ├── Evaluation │ │ ├── AbstractFExpression.cs │ │ ├── AbstractStackFunction.cs │ │ ├── Continuation.cs │ │ ├── DelegateFunctions.cs │ │ ├── DelegateTask.cs │ │ ├── EvaluateFExpression.cs │ │ ├── EvaluateTask.cs │ │ ├── EvaluationException.cs │ │ ├── Evaluator.cs │ │ ├── FExpression.cs │ │ ├── Function.cs │ │ ├── FunctionExpression.cs │ │ ├── IEnvironment.cs │ │ ├── IStack.cs │ │ ├── LexicalEnvironment.cs │ │ ├── Stack.cs │ │ ├── StackFunction.cs │ │ ├── StackFunctionAdapter.cs │ │ ├── Statistics.cs │ │ └── Task.cs │ ├── Lexing │ │ ├── Scanner.cs │ │ ├── Token.cs │ │ └── TokenType.cs │ ├── LispEngine.csproj │ ├── Parsing │ │ ├── ParseException.cs │ │ └── Parser.cs │ ├── Properties │ │ └── AssemblyInfo.cs │ ├── ReflectionBinding │ │ ├── ReflectionBuiltins.cs │ │ └── ReflectionBuiltins.lisp │ └── Util │ │ └── ResourceLoader.cs ├── LispTests │ ├── Datums │ │ └── DatumTest.cs │ ├── Evaluation │ │ ├── AmbTests.lisp │ │ ├── ArithmeticTests.lisp │ │ ├── CallCCTests.lisp │ │ ├── DotNetTests.lisp │ │ ├── EvalTests.lisp │ │ ├── EvaluatorTests.cs │ │ ├── EvaluatorTests.lisp │ │ ├── LibraryTests.lisp │ │ ├── MacroBuiltinTests.lisp │ │ ├── PatternMatchingTests.lisp │ │ ├── QuasiquoteTests.lisp │ │ ├── SudokuTests.lisp │ │ ├── VectorTests.lisp │ │ └── � │ ├── LispTests.csproj │ ├── Parsing │ │ ├── Lexing │ │ │ └── ScannerTest.cs │ │ ├── MultilineFile.lisp │ │ ├── MultilineFile.lisp~ │ │ └── ParserTest.cs │ └── Properties │ │ └── AssemblyInfo.cs └── Packages │ └── NUnit │ ├── NUnit.nupkg │ ├── lib │ ├── nunit.framework.dll │ └── nunit.framework.xml │ └── license.txt └── README.md /Dist/Examples/Sudoku.lisp: -------------------------------------------------------------------------------- 1 | (define digits '(1 2 3 4 5 6 7 8 9)) 2 | 3 | ; For efficiency, we'll use a single integer 4 | ; 'bit field' to represent which digits are 5 | ; available. 0 means a contradiction. 6 | ; We do this rather than implement 7 | ; lots of builtin string primitives, which 8 | ; would have been the thing to do if we'd 9 | ; followed Peter Norvig's Python program 10 | ; exactly. 11 | (define (sub1 x) 12 | (- x 1)) 13 | 14 | (define (digit-bit digit) 15 | (bit-shift 1 (sub1 digit))) 16 | 17 | (define (add-digit ds d) 18 | (bit-or ds (digit-bit d))) 19 | 20 | (define solved-digit? 21 | (lambda (1) 1 22 | (2) 2 23 | (4) 3 24 | (8) 4 25 | (16) 5 26 | (32) 6 27 | (64) 7 28 | (128) 8 29 | (256) 9 30 | (_) #f)) 31 | 32 | (define (digit-set . digits) 33 | (fold-loop d digits 34 | ds 0 35 | (add-digit ds d))) 36 | 37 | (define all-digits (apply digit-set digits)) 38 | (define none (digit-set)) 39 | 40 | (define zero? (curry eq? 0)) 41 | (define none? zero?) 42 | (define not-zero? (compose2 not zero?)) 43 | 44 | (define (remove-digit ds d) 45 | (bit-and ds (- all-digits (digit-bit d)))) 46 | 47 | (define (has-digit? ds d) 48 | (not-zero? (bit-and (digit-bit d) ds))) 49 | 50 | ; Inverse function of digit-set constructor 51 | (define (show-digits ds) 52 | (filter-loop d digits 53 | (has-digit? ds d))) 54 | 55 | (define num-squares 81) 56 | 57 | (define (index (row . column)) 58 | (+ (sub1 column) (* (sub1 row) 9))) 59 | 60 | ; Grid representation. Use a vector 61 | ; and row/column arithmetic. 62 | (define empty-grid 63 | (make-vector num-squares all-digits)) 64 | 65 | (define get-square vector-ref) 66 | 67 | (define set-square! vector-set!) 68 | 69 | (define (get-digits grid s) 70 | (show-digits (get-square grid s))) 71 | 72 | (define copy-grid vector-copy) 73 | (define (new-grid) 74 | (copy-grid empty-grid)) 75 | 76 | ; Use digits for rows and the columns 77 | (define rows digits) 78 | (define cols digits) 79 | (define cross cartesian) 80 | (define squares (mapcar index (cross rows cols))) 81 | (define divisions '((1 2 3) (4 5 6) (7 8 9))) 82 | (define unitlist 83 | (loop cons-unit 84 | (append 85 | (cartesian-map cross divisions divisions) 86 | (loop c cols (cross rows (list c))) 87 | (loop r rows (cross (list r) cols))) 88 | (mapcar index cons-unit))) 89 | 90 | (define (units-for-square s) 91 | (filter-loop unit unitlist (in s unit))) 92 | 93 | (define (peers-for-square s) 94 | (remove s (flatten (get-square units s)))) 95 | 96 | (define (make-grid square-function) 97 | (let g (make-vector num-squares) 98 | (loop s squares 99 | (set-square! g s (square-function s))) 100 | g)) 101 | 102 | (define units (make-grid units-for-square)) 103 | (define peers (make-grid peers-for-square)) 104 | 105 | (define (grid->lists grid) 106 | (loop r digits 107 | (loop c digits 108 | (show-digits (get-square grid (index (cons r c))))))) 109 | 110 | (define (string->list s) 111 | (define (convert char) 112 | (let schar (.ToString char) 113 | (if (System.Char/IsDigit char) 114 | (System.Convert/ToInt32 schar) 115 | (eq? "." schar) 116 | 'dot 117 | (string->symbol schar)))) 118 | (with (array (.ToCharArray s) 119 | length (.get_Length s)) 120 | (repeat (lambda (i) 121 | (convert (.GetValue array i))) length))) 122 | 123 | (define zip (curry map cons)) 124 | (define (grid->values grid) 125 | (let values (filter-loop c (string->list grid) 126 | (or (in c digits) (in c '(0 dot)))) 127 | (if (eq? (length values) num-squares) 128 | (zip squares values) 129 | (throw "Could not parse grid")))) 130 | 131 | (define amb (make-amb-function (curry throw "No solution"))) 132 | (define fail amb) 133 | 134 | ; After removing d from s and its peers, 135 | ; does d now only appear in one place for the units 136 | ; of s? If so, "assign" to that place. 137 | (define (check-units! grid s d) 138 | (fold-loop u (get-square units s) 139 | g grid 140 | ; Find squares in this unit which have this digit 141 | (match (filter-loop s u (has-digit? (get-square g s) d)) 142 | () (fail) ; d cannot appear anywhere in some unit => contradiction 143 | ; d only appears in one square => 144 | ; assign d to square s in values 145 | (s) (assign! g s d ) 146 | ; No inference possible: do nothing. 147 | _ g))) 148 | 149 | (define (eliminate-peers! grid s remaining) 150 | (match (solved-digit? remaining) 151 | #f grid 152 | d (fold-loop peer (get-square peers s) 153 | g grid 154 | (eliminate! g peer d)))) 155 | 156 | (define (apply-rules grid s d remaining) 157 | (if (none? remaining) 158 | (fail) 159 | (begin 160 | (set-square! grid s remaining) 161 | (eliminate-peers! grid s remaining) 162 | (check-units! grid s d)))) 163 | 164 | ; Eliminate digit d from square s 165 | (define (eliminate! grid s d) 166 | (define current (get-square grid s)) 167 | ; This test required to terminate the 168 | ; recursion 169 | (if (has-digit? current d) 170 | (apply-rules grid s d (remove-digit current d)) 171 | grid)) 172 | 173 | ; Return the 'values' that results from 174 | ; assigning d to square s 175 | (define (assign! grid s d) 176 | (define others (remove-digit (get-square grid s) d)) 177 | (fold-loop d (show-digits others) 178 | g grid 179 | (eliminate! g s d))) 180 | 181 | (define (digit? d) 182 | (in d digits)) 183 | 184 | (define (parse-grid grid-string) 185 | (fold-loop (s . d) (grid->values grid-string) 186 | g (new-grid) 187 | (if (digit? d) 188 | (assign! g s d) 189 | g))) 190 | 191 | (define (solved? grid) 192 | (let-cc return 193 | (index-loop i num-squares 194 | (if (solved-digit? (vector-ref grid i)) 195 | #t 196 | (return #f))) 197 | #t)) 198 | 199 | (define two-through-9 (cdr digits)) 200 | 201 | (define (square-to-try grid) 202 | (let-cc return 203 | (loop num-missing two-through-9 204 | (loop s squares 205 | (let possible (show-digits (get-square grid s)) 206 | (if (eq? (length possible) num-missing) 207 | (return (cons s possible)) 208 | #f)))) 209 | return "None missing")) 210 | 211 | (define (solve grid) 212 | (if (solved? grid) 213 | grid 214 | (with* ((s . digits) (square-to-try grid) 215 | d (amb digits)) 216 | (write-line "Assiging {0} to {1}" d s) 217 | (solve (assign! (copy-grid grid) s d))))) 218 | 219 | (define (display-grid grid) 220 | (loop row (grid->lists grid) 221 | (write-line "{0}" row)) 222 | nil) 223 | 224 | (define grid1 "003020600900305001001806400008102900700000008006708200002609500800203009005010300") 225 | (define grid2 "4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......") 226 | ; Hardest puzzle from http://www.mirror.co.uk/news/weird-news/worlds-hardest-sudoku-can-you-242294 227 | (define inkala-hardest 228 | (System.String/Concat 229 | "..5 3.. ..." 230 | "8.. ... .2." 231 | ".7. .1. 5.." 232 | "4.. ..5 3.." 233 | ".1. .7. ..6" 234 | "..3 2.. .8." 235 | ".6. 5.. ..9" 236 | "..4 ... .3." 237 | "... ..9 7..")) 238 | 239 | (write-line "Solving grid1...") 240 | (define parsed1 (parse-grid grid1)) 241 | (display-grid parsed1) 242 | (write-line "Solving grid2...") 243 | (define parsed2 (parse-grid grid2)) 244 | (write-line "With rote deduction we only get to:") 245 | (display-grid parsed2) 246 | (write-line "Solving using non-deterministic search...") 247 | (define solution2 (solve parsed2)) 248 | (write-line "Solution:") 249 | (display-grid solution2) 250 | -------------------------------------------------------------------------------- /Dist/Examples/fibonacci.lisp: -------------------------------------------------------------------------------- 1 | ; The archetypical fibonacci program... 2 | (define (fib n) 3 | (match n 4 | 0 0 5 | 1 1 6 | n (+ (fib (- n 1)) (fib (- n 2))))) 7 | (display (fib 8)) 8 | -------------------------------------------------------------------------------- /Dist/Lisp.exe: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Patient0/FirstClassLisp/261c7ed81cc75f399c4989814717ee474291b641/Dist/Lisp.exe -------------------------------------------------------------------------------- /Dist/LispEngine.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Patient0/FirstClassLisp/261c7ed81cc75f399c4989814717ee474291b641/Dist/LispEngine.dll -------------------------------------------------------------------------------- /Lisp/.gitignore: -------------------------------------------------------------------------------- 1 | #ignore thumbnails created by windows 2 | Thumbs.db 3 | #Ignore files build by Visual Studio 4 | *.obj 5 | *.exe 6 | *.pdb 7 | *.user 8 | *.aps 9 | *.pch 10 | *.vspscc 11 | *_i.c 12 | *_p.c 13 | *.ncb 14 | *.suo 15 | *.tlb 16 | *.tlh 17 | *.bak 18 | *.cache 19 | *.ilk 20 | *.log 21 | *.swp 22 | *~ 23 | [Bb]in 24 | [Dd]ebug*/ 25 | *.lib 26 | *.sbr 27 | obj/ 28 | [Rr]elease*/ 29 | _ReSharper*/ 30 | [Tt]est[Rr]esult* 31 | -------------------------------------------------------------------------------- /Lisp/Lisp.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 11.00 3 | # Visual Studio 2010 4 | Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "Lisp", "Lisp\Lisp.csproj", "{F4859844-A8FB-4CE4-9184-2DD789A07085}" 5 | EndProject 6 | Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "LispTests", "LispTests\LispTests.csproj", "{2517BF60-4567-456F-AE2E-25B280AD24F2}" 7 | EndProject 8 | Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "LispEngine", "LispEngine\LispEngine.csproj", "{81EE52DF-F912-4FE5-973C-262762CA3B99}" 9 | EndProject 10 | Global 11 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 12 | Debug|Any CPU = Debug|Any CPU 13 | Debug|Mixed Platforms = Debug|Mixed Platforms 14 | Debug|x86 = Debug|x86 15 | Release|Any CPU = Release|Any CPU 16 | Release|Mixed Platforms = Release|Mixed Platforms 17 | Release|x86 = Release|x86 18 | EndGlobalSection 19 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 20 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Debug|Any CPU.ActiveCfg = Debug|x86 21 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Debug|Mixed Platforms.ActiveCfg = Debug|x86 22 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Debug|Mixed Platforms.Build.0 = Debug|x86 23 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Debug|x86.ActiveCfg = Debug|x86 24 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Debug|x86.Build.0 = Debug|x86 25 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Release|Any CPU.ActiveCfg = Release|x86 26 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Release|Mixed Platforms.ActiveCfg = Release|x86 27 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Release|Mixed Platforms.Build.0 = Release|x86 28 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Release|x86.ActiveCfg = Release|x86 29 | {F4859844-A8FB-4CE4-9184-2DD789A07085}.Release|x86.Build.0 = Release|x86 30 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 31 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Debug|Any CPU.Build.0 = Debug|Any CPU 32 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Debug|Mixed Platforms.ActiveCfg = Debug|Any CPU 33 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Debug|Mixed Platforms.Build.0 = Debug|Any CPU 34 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Debug|x86.ActiveCfg = Debug|Any CPU 35 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Release|Any CPU.ActiveCfg = Release|Any CPU 36 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Release|Any CPU.Build.0 = Release|Any CPU 37 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU 38 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Release|Mixed Platforms.Build.0 = Release|Any CPU 39 | {2517BF60-4567-456F-AE2E-25B280AD24F2}.Release|x86.ActiveCfg = Release|Any CPU 40 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 41 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Debug|Any CPU.Build.0 = Debug|Any CPU 42 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Debug|Mixed Platforms.ActiveCfg = Debug|Any CPU 43 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Debug|Mixed Platforms.Build.0 = Debug|Any CPU 44 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Debug|x86.ActiveCfg = Debug|Any CPU 45 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Release|Any CPU.ActiveCfg = Release|Any CPU 46 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Release|Any CPU.Build.0 = Release|Any CPU 47 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Release|Mixed Platforms.ActiveCfg = Release|Any CPU 48 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Release|Mixed Platforms.Build.0 = Release|Any CPU 49 | {81EE52DF-F912-4FE5-973C-262762CA3B99}.Release|x86.ActiveCfg = Release|Any CPU 50 | EndGlobalSection 51 | GlobalSection(SolutionProperties) = preSolution 52 | HideSolutionNode = FALSE 53 | EndGlobalSection 54 | EndGlobal 55 | -------------------------------------------------------------------------------- /Lisp/Lisp/Examples/Sudoku.lisp: -------------------------------------------------------------------------------- 1 | (define digits '(1 2 3 4 5 6 7 8 9)) 2 | 3 | ; For efficiency, we'll use a single integer 4 | ; 'bit field' to represent which digits are 5 | ; available. 0 means a contradiction. 6 | ; We do this rather than implement 7 | ; lots of builtin string primitives, which 8 | ; would have been the thing to do if we'd 9 | ; followed Peter Norvig's Python program 10 | ; exactly. 11 | (define (sub1 x) 12 | (- x 1)) 13 | 14 | (define (digit-bit digit) 15 | (bit-shift 1 (sub1 digit))) 16 | 17 | (define (add-digit ds d) 18 | (bit-or ds (digit-bit d))) 19 | 20 | (define solved-digit? 21 | (lambda (1) 1 22 | (2) 2 23 | (4) 3 24 | (8) 4 25 | (16) 5 26 | (32) 6 27 | (64) 7 28 | (128) 8 29 | (256) 9 30 | (_) #f)) 31 | 32 | (define (digit-set . digits) 33 | (fold-loop d digits 34 | ds 0 35 | (add-digit ds d))) 36 | 37 | (define all-digits (apply digit-set digits)) 38 | (define none (digit-set)) 39 | 40 | (define zero? (curry eq? 0)) 41 | (define none? zero?) 42 | (define not-zero? (compose2 not zero?)) 43 | 44 | (define (remove-digit ds d) 45 | (bit-and ds (- all-digits (digit-bit d)))) 46 | 47 | (define (has-digit? ds d) 48 | (not-zero? (bit-and (digit-bit d) ds))) 49 | 50 | ; Inverse function of digit-set constructor 51 | (define (show-digits ds) 52 | (filter-loop d digits 53 | (has-digit? ds d))) 54 | 55 | (define num-squares 81) 56 | 57 | (define (index (row . column)) 58 | (+ (sub1 column) (* (sub1 row) 9))) 59 | 60 | ; Grid representation. Use a vector 61 | ; and row/column arithmetic. 62 | (define empty-grid 63 | (make-vector num-squares all-digits)) 64 | 65 | (define get-square vector-ref) 66 | 67 | (define set-square! vector-set!) 68 | 69 | (define (get-digits grid s) 70 | (show-digits (get-square grid s))) 71 | 72 | (define copy-grid vector-copy) 73 | (define (new-grid) 74 | (copy-grid empty-grid)) 75 | 76 | ; Use digits for rows and the columns 77 | (define rows digits) 78 | (define cols digits) 79 | (define cross cartesian) 80 | (define squares (mapcar index (cross rows cols))) 81 | (define divisions '((1 2 3) (4 5 6) (7 8 9))) 82 | (define unitlist 83 | (loop cons-unit 84 | (append 85 | (cartesian-map cross divisions divisions) 86 | (loop c cols (cross rows (list c))) 87 | (loop r rows (cross (list r) cols))) 88 | (mapcar index cons-unit))) 89 | 90 | (define (units-for-square s) 91 | (filter-loop unit unitlist (in s unit))) 92 | 93 | (define (peers-for-square s) 94 | (remove s (flatten (get-square units s)))) 95 | 96 | (define (make-grid square-function) 97 | (let g (make-vector num-squares) 98 | (loop s squares 99 | (set-square! g s (square-function s))) 100 | g)) 101 | 102 | (define units (make-grid units-for-square)) 103 | (define peers (make-grid peers-for-square)) 104 | 105 | (define (grid->lists grid) 106 | (loop r digits 107 | (loop c digits 108 | (show-digits (get-square grid (index (cons r c))))))) 109 | 110 | (define (string->list s) 111 | (define (convert char) 112 | (let schar (.ToString char) 113 | (if (System.Char/IsDigit char) 114 | (System.Convert/ToInt32 schar) 115 | (eq? "." schar) 116 | 'dot 117 | (string->symbol schar)))) 118 | (with (array (.ToCharArray s) 119 | length (.get_Length s)) 120 | (repeat (lambda (i) 121 | (convert (.GetValue array i))) length))) 122 | 123 | (define zip (curry map cons)) 124 | (define (grid->values grid) 125 | (let values (filter-loop c (string->list grid) 126 | (or (in c digits) (in c '(0 dot)))) 127 | (if (eq? (length values) num-squares) 128 | (zip squares values) 129 | (throw "Could not parse grid")))) 130 | 131 | (define amb (make-amb-function (curry throw "No solution"))) 132 | (define fail amb) 133 | 134 | ; After removing d from s and its peers, 135 | ; does d now only appear in one place for the units 136 | ; of s? If so, "assign" to that place. 137 | (define (check-units! grid s d) 138 | (fold-loop u (get-square units s) 139 | g grid 140 | ; Find squares in this unit which have this digit 141 | (match (filter-loop s u (has-digit? (get-square g s) d)) 142 | () (fail) ; d cannot appear anywhere in some unit => contradiction 143 | ; d only appears in one square => 144 | ; assign d to square s in values 145 | (s) (assign! g s d ) 146 | ; No inference possible: do nothing. 147 | _ g))) 148 | 149 | (define (eliminate-peers! grid s remaining) 150 | (match (solved-digit? remaining) 151 | #f grid 152 | d (fold-loop peer (get-square peers s) 153 | g grid 154 | (eliminate! g peer d)))) 155 | 156 | (define (apply-rules grid s d remaining) 157 | (if (none? remaining) 158 | (fail) 159 | (begin 160 | (set-square! grid s remaining) 161 | (eliminate-peers! grid s remaining) 162 | (check-units! grid s d)))) 163 | 164 | ; Eliminate digit d from square s 165 | (define (eliminate! grid s d) 166 | (define current (get-square grid s)) 167 | ; This test required to terminate the 168 | ; recursion 169 | (if (has-digit? current d) 170 | (apply-rules grid s d (remove-digit current d)) 171 | grid)) 172 | 173 | ; Return the 'values' that results from 174 | ; assigning d to square s 175 | (define (assign! grid s d) 176 | (define others (remove-digit (get-square grid s) d)) 177 | (fold-loop d (show-digits others) 178 | g grid 179 | (eliminate! g s d))) 180 | 181 | (define (digit? d) 182 | (in d digits)) 183 | 184 | (define (parse-grid grid-string) 185 | (fold-loop (s . d) (grid->values grid-string) 186 | g (new-grid) 187 | (if (digit? d) 188 | (assign! g s d) 189 | g))) 190 | 191 | (define (solved? grid) 192 | (let-cc return 193 | (index-loop i num-squares 194 | (if (solved-digit? (vector-ref grid i)) 195 | #t 196 | (return #f))) 197 | #t)) 198 | 199 | (define two-through-9 (cdr digits)) 200 | 201 | (define (square-to-try grid) 202 | (let-cc return 203 | (loop num-missing two-through-9 204 | (loop s squares 205 | (let possible (show-digits (get-square grid s)) 206 | (if (eq? (length possible) num-missing) 207 | (return (cons s possible)) 208 | #f)))) 209 | return "None missing")) 210 | 211 | (define (solve grid) 212 | (if (solved? grid) 213 | grid 214 | (with* ((s . digits) (square-to-try grid) 215 | d (amb digits)) 216 | (write-line "Assiging {0} to {1}" d s) 217 | (solve (assign! (copy-grid grid) s d))))) 218 | 219 | (define (display-grid grid) 220 | (loop row (grid->lists grid) 221 | (write-line "{0}" row)) 222 | nil) 223 | 224 | (define grid1 "003020600900305001001806400008102900700000008006708200002609500800203009005010300") 225 | (define grid2 "4.....8.5.3..........7......2.....6.....8.4......1.......6.3.7.5..2.....1.4......") 226 | ; Hardest puzzle from http://www.mirror.co.uk/news/weird-news/worlds-hardest-sudoku-can-you-242294 227 | (define inkala-hardest 228 | (System.String/Concat 229 | "..5 3.. ..." 230 | "8.. ... .2." 231 | ".7. .1. 5.." 232 | "4.. ..5 3.." 233 | ".1. .7. ..6" 234 | "..3 2.. .8." 235 | ".6. 5.. ..9" 236 | "..4 ... .3." 237 | "... ..9 7..")) 238 | 239 | (write-line "Solving grid1...") 240 | (define parsed1 (parse-grid grid1)) 241 | (display-grid parsed1) 242 | (write-line "Solving grid2...") 243 | (define parsed2 (parse-grid grid2)) 244 | (write-line "With rote deduction we only get to:") 245 | (display-grid parsed2) 246 | (write-line "Solving using non-deterministic search...") 247 | (define solution2 (solve parsed2)) 248 | (write-line "Solution:") 249 | (display-grid solution2) 250 | -------------------------------------------------------------------------------- /Lisp/Lisp/Examples/fibonacci.lisp: -------------------------------------------------------------------------------- 1 | ; The archetypical fibonacci program... 2 | (define (fib n) 3 | (match n 4 | 0 0 5 | 1 1 6 | n (+ (fib (- n 1)) (fib (- n 2))))) 7 | (display (fib 8)) 8 | -------------------------------------------------------------------------------- /Lisp/Lisp/Lisp.csproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Debug 5 | x86 6 | 8.0.30703 7 | 2.0 8 | {F4859844-A8FB-4CE4-9184-2DD789A07085} 9 | Exe 10 | Properties 11 | Lisp 12 | Lisp 13 | v4.0 14 | Client 15 | 512 16 | publish\ 17 | true 18 | Disk 19 | false 20 | Foreground 21 | 7 22 | Days 23 | false 24 | false 25 | true 26 | 0 27 | 1.0.0.%2a 28 | false 29 | false 30 | true 31 | 32 | 33 | x86 34 | true 35 | full 36 | false 37 | bin\Debug\ 38 | DEBUG;TRACE 39 | prompt 40 | 4 41 | 42 | 43 | x86 44 | pdbonly 45 | true 46 | bin\Release\ 47 | TRACE 48 | prompt 49 | 4 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | {81EE52DF-F912-4FE5-973C-262762CA3B99} 67 | LispEngine 68 | 69 | 70 | 71 | 72 | PreserveNewest 73 | 74 | 75 | 76 | PreserveNewest 77 | 78 | 79 | 80 | 81 | False 82 | Microsoft .NET Framework 4 Client Profile %28x86 and x64%29 83 | true 84 | 85 | 86 | False 87 | .NET Framework 3.5 SP1 Client Profile 88 | false 89 | 90 | 91 | False 92 | .NET Framework 3.5 SP1 93 | false 94 | 95 | 96 | False 97 | Windows Installer 3.1 98 | true 99 | 100 | 101 | 102 | 109 | -------------------------------------------------------------------------------- /Lisp/Lisp/Program.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Reflection; 3 | using LispEngine.Bootstrap; 4 | using LispEngine.Datums; 5 | using LispEngine.Evaluation; 6 | using LispEngine.Util; 7 | 8 | namespace Lisp 9 | { 10 | class Program 11 | { 12 | static void Main(string[] args) 13 | { 14 | try 15 | { 16 | var env = StandardEnvironment.Create(); 17 | env.Define("args", DatumHelpers.atomList(args)); 18 | var statistics = new Statistics(); 19 | env = statistics.AddTo(env); 20 | ResourceLoader.ExecuteResource(statistics, Assembly.GetExecutingAssembly(), env, "Lisp.REPL.lisp"); 21 | } 22 | catch (Exception ex) 23 | { 24 | Console.Error.WriteLine("ERROR:\n{0}\n{1}\n", ex, ex.StackTrace); 25 | } 26 | 27 | } 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /Lisp/Lisp/Properties/AssemblyInfo.cs: -------------------------------------------------------------------------------- 1 | using System.Reflection; 2 | using System.Runtime.CompilerServices; 3 | using System.Runtime.InteropServices; 4 | 5 | // General Information about an assembly is controlled through the following 6 | // set of attributes. Change these attribute values to modify the information 7 | // associated with an assembly. 8 | [assembly: AssemblyTitle("Lisp")] 9 | [assembly: AssemblyDescription("")] 10 | [assembly: AssemblyConfiguration("")] 11 | [assembly: AssemblyCompany("")] 12 | [assembly: AssemblyProduct("Lisp")] 13 | [assembly: AssemblyCopyright("Copyright © 2012")] 14 | [assembly: AssemblyTrademark("")] 15 | [assembly: AssemblyCulture("")] 16 | 17 | // Setting ComVisible to false makes the types in this assembly not visible 18 | // to COM components. If you need to access a type in this assembly from 19 | // COM, set the ComVisible attribute to true on that type. 20 | [assembly: ComVisible(false)] 21 | 22 | // The following GUID is for the ID of the typelib if this project is exposed to COM 23 | [assembly: Guid("2a974d22-dbe6-41ee-a586-79728a428771")] 24 | 25 | // Version information for an assembly consists of the following four values: 26 | // 27 | // Major Version 28 | // Minor Version 29 | // Build Number 30 | // Revision 31 | // 32 | // You can specify all the values or you can default the Build and Revision Numbers 33 | // by using the '*' as shown below: 34 | // [assembly: AssemblyVersion("1.0.*")] 35 | [assembly: AssemblyVersion("1.0.0.0")] 36 | [assembly: AssemblyFileVersion("1.0.0.0")] 37 | -------------------------------------------------------------------------------- /Lisp/Lisp/REPL.lisp: -------------------------------------------------------------------------------- 1 | (define global-env (env)) 2 | (define repl-run 3 | (let standard-run run 4 | (lambda 5 | (filename run-environment) 6 | (standard-run filename run-environment) 7 | (filename) 8 | (standard-run filename global-env)))) 9 | ; Redefine 'run' to a user-friendly version 10 | ; that defaults to the repl-environment for 11 | ; evaluation 12 | (define run repl-run) 13 | 14 | (define prev-stats (!get-statistics)) 15 | (define (log-steps elapsed) 16 | (with (stats (!get-statistics) 17 | delta (!get-statistics-delta prev-stats)) 18 | (set! prev-stats stats) 19 | (write-line "{0} Elapsed: {1}" delta elapsed))) 20 | 21 | (define (display-error msg c) 22 | (define (indent-list continuation-fn) 23 | (loop f (continuation-fn c) 24 | (writeerr "\t{0}" f))) 25 | (writeerr "ERROR: {0}" msg) 26 | (writeerr "Tasks:") 27 | (indent-list task-descriptions) 28 | (writeerr "Results:") 29 | (indent-list pending-results) 30 | nil) 31 | 32 | ; Create a new environment with the specified definitions 33 | (define (extend e . definitions) 34 | (define (extend1 (symbol definition) e) 35 | (eval 36 | `(,begin 37 | (,define ,symbol ,definition) 38 | (,env)) 39 | e)) 40 | (fold-right extend1 e definitions)) 41 | 42 | (define (make-debug-env (msg c)) 43 | (extend (get-env c) 44 | `(trace ,(curry display-error msg c)) 45 | `(resume ,c))) 46 | 47 | (define last-error nil) 48 | ; Rudimentary repl that lets you evaluate 49 | ; expressions within the context of "last-error". 50 | (define (debug) 51 | (if (nil? last-error) 52 | "Nothing to debug" 53 | (repl "debug> " (make-debug-env last-error)))) 54 | 55 | (define Stopwatch System.Diagnostics.Stopwatch) 56 | 57 | (define clear System.Console/Clear) 58 | 59 | (define (repl prompt repl-env) 60 | (define prompt (curry write prompt)) 61 | (let-cc return 62 | (define env-with-exit-and-debug 63 | (extend repl-env 64 | `(exit ,(curry return nil)) 65 | `(debug ,debug))) 66 | (define (check-read) 67 | (let next (read console) 68 | (if (eof-object? next) 69 | (return nil) 70 | next))) 71 | (define (repl-eval expr) 72 | (eval expr env-with-exit-and-debug)) 73 | 74 | (define (loop) 75 | (try 76 | (prompt) 77 | (with* (expr (check-read) 78 | stop-watch (Stopwatch/StartNew) 79 | result (repl-eval expr)) 80 | (display result) 81 | (log-steps (.get_Elapsed stop-watch))) 82 | catch error 83 | (set! last-error error) 84 | (writeerr "ERROR: {0}" (car error)) 85 | (writeerr "(debug) to enter debug repl")) 86 | (loop)) 87 | (loop))) 88 | 89 | (repl "FCLisp> " global-env) 90 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Bootstrap/Append.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Bootstrap 9 | { 10 | class Append : Function 11 | { 12 | // We could implement this in pure lisp but I'm lazy 13 | // and it's trivial. 14 | public static readonly StackFunction Instance = new Append().ToStack(); 15 | public Datum Evaluate(Datum args) 16 | { 17 | return args.Enumerate() 18 | .Aggregate(Enumerable.Empty(), (current, a) => current.Concat(a.Enumerate())) 19 | .ToList(); 20 | } 21 | 22 | public override string ToString() 23 | { 24 | return ",append"; 25 | } 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Bootstrap/Arithmetic.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Core; 6 | using LispEngine.Datums; 7 | using LispEngine.Evaluation; 8 | 9 | namespace LispEngine.Bootstrap 10 | { 11 | class Arithmetic : DatumHelpers 12 | { 13 | private delegate object Op(int x, int y); 14 | 15 | class Operation : BinaryFunction 16 | { 17 | private readonly string name; 18 | private readonly Op op; 19 | public Operation(string name, Op op) 20 | { 21 | this.name = name; 22 | this.op = op; 23 | } 24 | protected override Datum eval(Datum arg1, Datum arg2) 25 | { 26 | return atom(op(castInt(arg1), castInt(arg2))); 27 | } 28 | public override string ToString() 29 | { 30 | return name; 31 | } 32 | } 33 | 34 | private static StackFunction makeOperation(string name, Op op) 35 | { 36 | return new Operation(name, op).ToStack(); 37 | } 38 | 39 | public static LexicalEnvironment Extend(LexicalEnvironment env) 40 | { 41 | return env 42 | .Define("+", makeOperation("+", (x, y) => x + y)) 43 | .Define("-", makeOperation("-", (x, y) => x - y)) 44 | .Define("*", makeOperation("*", (x, y) => x*y)) 45 | .Define("/", makeOperation("/", (x, y) => x/y)) 46 | .Define("<", makeOperation("<", (x, y) => x < y)) 47 | .Define(">", makeOperation(">", (x, y) => x > y)) 48 | .Define("bit-and", makeOperation("bit-and", (x , y) => x & y)) 49 | .Define("bit-or", makeOperation("bit-or", (x, y) => x | y)) 50 | .Define("bit-shift", makeOperation("bit-shift", (x, y) => x << y)); 51 | } 52 | } 53 | } 54 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Bootstrap/Builtins.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.IO; 3 | using System.Reflection; 4 | using LispEngine.Core; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | using LispEngine.Lexing; 8 | using LispEngine.Parsing; 9 | using LispEngine.ReflectionBinding; 10 | using LispEngine.Util; 11 | 12 | namespace LispEngine.Bootstrap 13 | { 14 | /** 15 | * Here we define everything that can be defined in Lisp itself 16 | * from the Core. i.e. everything that is 'standard' but which 17 | * can be defined once the Core is defined. 18 | */ 19 | public sealed class Builtins 20 | { 21 | public static LexicalEnvironment AddTo(LexicalEnvironment env) 22 | { 23 | env = Arithmetic.Extend(env); 24 | env.Define("append", Append.Instance); 25 | env = SymbolFunctions.Extend(env); 26 | ResourceLoader.ExecuteResource(env, "LispEngine.Bootstrap.Builtins.lisp"); 27 | ResourceLoader.ExecuteResource(env, "LispEngine.Bootstrap.Library.lisp"); 28 | env = Reader.AddTo(env); 29 | return env; 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Bootstrap/Builtins.lisp: -------------------------------------------------------------------------------- 1 | (define nil '()) 2 | (define list (lambda x x)) 3 | (define car (lambda ((a . b)) a)) 4 | (define cdr (lambda ((c . d)) d)) 5 | (define nil? (lambda (()) #t _ #f)) 6 | (define pair? (lambda ((_ . _)) #t _ #f)) 7 | (define display log) 8 | 9 | ; Now, let's implement simple non-nested quasiquote in terms of Lisp itself 10 | ; We need it quite early because writing macros with*out quasiquote 11 | ; is extremely painful! 12 | ; Using the builtin pattern matching of our lambda primitive makes 13 | ; this significantly simpler to implement. 14 | (define expand-quasiquote 15 | (lambda 16 | (('unquote e)) 17 | e 18 | ((('unquote-splicing x) . y)) 19 | (list append x (expand-quasiquote y)) 20 | ((x . y)) 21 | (list cons (expand-quasiquote x) (expand-quasiquote y)) 22 | x 23 | (cons quote x))) 24 | (define quasiquote 25 | (macro expand-quasiquote)) 26 | 27 | ; We use define followed by macro and a lambda an awful lot - so 28 | ; let's define a macro to ease the overhead in 29 | ; writing macros! 30 | (define define-macro 31 | (macro (lambda (name args . exprs) 32 | `(,define ,name 33 | (,macro (,lambda ,args (,begin ,@exprs))))))) 34 | 35 | 36 | ; Our let macro is like the one in arc - just 37 | ; a single variable, single expression, and no 38 | ; nesting. 39 | ; We can define "with*" later as a macro that 40 | ; expands into individual sublets. 41 | (define-macro let (var value . body) 42 | `((,lambda (,var) (,begin ,@body)) ,value)) 43 | 44 | ; Our pattern matching is powerful enough to define 'if' 45 | ; as a macro. In fact, it can even handle 46 | ; "multicase" if, by expanding the remaining 47 | ; clauses into itself. 48 | (define if (macro 49 | (lambda (condition true-case false-case) 50 | ; Base case. Anything not false is considered 'true' 51 | `((,lambda (#f) ,false-case 52 | _ ,true-case) ,condition) 53 | ; Multiple clauses. Expand into recursive if statements. 54 | (condition true-case . remainder) 55 | `(,if ,condition ,true-case 56 | (,if ,@remainder))))) 57 | 58 | ; Now add support for multiple sub-statements in define: 59 | ; Whenever we see 60 | ; (define x expr1 expr2 ...) 61 | ; we'll expand it to 62 | ; (raw-define x (begin expr1 expr2 ...)) 63 | ; Also, whenever we see 64 | ; (define (name arg1 arg2) expr1 expr2) 65 | ; we'll expand it to 66 | ; (define name (lambda arg1 arg2) (begin expr1 expr2)) 67 | ; This is the traditional syntax used in SICP et al. 68 | ; However, we can't support multiple bodies in our 69 | ; lambdas with*out screwing up our nice 'case lambda' 70 | ; syntax which I find more useful than being able to 71 | ; define multiple bodies in a lambda. You can aways 72 | ; use 'begin' explicitly if need be. 73 | (define define 74 | (macro 75 | ; Because define itself mutates the environment, 76 | ; we have to capture the original 'define' here 77 | ; before we 'hide' it behind our macro replacement. 78 | ; Otherwise, we go into an infinite loop when expanding. 79 | (let raw-define define 80 | (lambda 81 | ; Traditional function definition 82 | ((fn . args) . exprs) 83 | `(,raw-define ,fn (,lambda ,args (,begin ,@exprs))) 84 | (symbol . exprs) 85 | `(,raw-define ,symbol (,begin ,@exprs)))))) 86 | 87 | (define (let-bindings bindings) 88 | (define splice 89 | (lambda (bindings ()) 90 | bindings 91 | ((vars values) (var value . rest)) 92 | (splice (list (cons var vars) (cons value values)) rest))) 93 | (let (vars values) (splice '(() ()) bindings) 94 | (list vars (cons list values)))) 95 | 96 | ; 'with' macro allows multiple bindings - but the bindings 97 | ; cannot see each other. i.e. 98 | ; (with (x 5 y x) ... ) won't work. 99 | ; However, this version is probably more efficient than with* below. 100 | (define-macro with (bindings . body) 101 | `(let ,@(let-bindings bindings) ,@body)) 102 | 103 | ; 'with*' macro decomposes recursively into nested 'let' statements 104 | ; So 'later' definitions can see earlier definitions. 105 | ; i.e. 106 | ; (with* (x 5 y x) ... ) will work. 107 | (define with* (macro 108 | (lambda (() body) 109 | body 110 | ((var . (expr . bindings)) . body) 111 | `(,let ,var ,expr (,with* ,bindings (,begin ,@body)))))) 112 | 113 | ; We cannot use "/" as this is overloaded to allow static method 114 | ; access ala Clojure style. 115 | (define call-cc call-with-current-continuation) 116 | 117 | ; let-cc provides "escape" functionality 118 | (define-macro let-cc (var . body) 119 | `(,call-cc (,lambda (,var) (,begin ,@body)))) 120 | 121 | ; Function that can be used to expand a (possibly) 122 | ; macro-ized expression. Useful for debugging 123 | ; macros. The 'trick' part is the "unmacro" 124 | ; builtin which is the inverse function of 'macro'. 125 | (define expand 126 | (lambda (env (fexpr . args)) 127 | (with* (macro-expr (eval fexpr env) 128 | macro-fn (unmacro macro-expr)) 129 | (if (nil? macro-fn) 130 | (cons fexpr args) 131 | (apply macro-fn args))) 132 | (env other) other)) 133 | 134 | ; In the common case of only wanting to 135 | ; dispatch on the pattern of one variable, 136 | ; define a convenient macro to de-nest 137 | ; the arguments that would otherwise 138 | ; be required in a plain lambda expression 139 | (define-macro match (var . cases) 140 | (define de-nest 141 | (lambda 142 | (()) () 143 | ((pattern . (body . remaining))) 144 | `(,(list pattern) ,body ,@(de-nest remaining)))) 145 | `((,lambda ,@(de-nest cases)) ,var)) 146 | 147 | (define (not expr) 148 | (match expr 149 | #f #t 150 | _ #f)) 151 | 152 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Bootstrap/Builtins.lisp~: -------------------------------------------------------------------------------- 1 | (define list (lambda x x)) 2 | (define car (lambda ((x . y)) x)) 3 | (define cdr (lambda ((x . y)) y)) 4 | (define nil? (lambda (()) #t _ #f)) 5 | (define pair? (lambda ((_ . _)) #t _ #f)) 6 | (define let (macro 7 | (lambda (var value body) 8 | (list (list lambda (list var) body) value)))) 9 | 10 | ; b.add("list", "(lambda x x)"); 11 | ; b.add("car", "(lambda ((x . y)) x)"); 12 | ; b.add("cdr", "(lambda ((x . y)) y)"); 13 | ; b.add("nil?", "(lambda (()) #t _ #f)"); 14 | ; b.add("pair?", "(lambda ((_ . _)) #t _ #f)"); 15 | ; b.add("letdef", "(lambda (var value body) (list (list lambda (list var) body) value))"); 16 | ; b.add("let", "(macro letdef)"); 17 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Bootstrap/IO.lisp: -------------------------------------------------------------------------------- 1 | ; Functions for input and output 2 | ; Defined using .Net bindings for the most part 3 | 4 | ; Read a file into a list of s-expressions 5 | ; Not very elegant until we build in some sort of RAII 6 | (define (read-file filename) 7 | (let-cc return 8 | (let file-stream (System.IO.File/OpenRead filename) 9 | (try 10 | (with* (text-reader (new System.IO.StreamReader file-stream) 11 | input (open-input-stream text-reader)) 12 | (define (loop so-far) 13 | (let next (read input) 14 | (if (eof-object? next) 15 | (begin 16 | (.Dispose file-stream) 17 | (return (reverse so-far))) 18 | (loop (cons next so-far))))) 19 | (loop nil)) 20 | catch (msg c) 21 | ; Not quite ideal. Ideally we'd "throw" the 22 | ; original continuation along with this. 23 | (.Dispose file-stream) 24 | throw msg)))) 25 | 26 | 27 | (define pwd System.IO.Directory/GetCurrentDirectory) 28 | 29 | ; Load an execute a lisp file using the specified 30 | ; environment 31 | (define (run filename run-environment) 32 | (define last-result nil) 33 | (loop expr (read-file filename) 34 | (set! last-result (eval expr run-environment))) 35 | last-result) 36 | 37 | (define system-console System.Console) 38 | (define console (open-input-stream (system-console/get_In))) 39 | (define display (curry system-console/WriteLine "-> {0}")) 40 | (define writeerr (curry .WriteLine (system-console/get_Error))) 41 | (define write system-console/Write) 42 | (define write-line system-console/WriteLine) 43 | 44 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Bootstrap/Reader.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.IO; 4 | using System.Linq; 5 | using System.Text; 6 | using LispEngine.Core; 7 | using LispEngine.Datums; 8 | using LispEngine.Evaluation; 9 | using LispEngine.Lexing; 10 | using LispEngine.Parsing; 11 | 12 | namespace LispEngine.Bootstrap 13 | { 14 | class Reader 15 | { 16 | class Eof 17 | { 18 | public override string ToString() 19 | { 20 | return "#!eof"; 21 | } 22 | } 23 | 24 | private static readonly Datum eof = new Eof().ToAtom(); 25 | 26 | class Read : UnaryFunction 27 | { 28 | protected override Datum eval(Datum arg) 29 | { 30 | var parser = (Parser)arg.CastObject(); 31 | return parser.parse() ?? eof; 32 | } 33 | 34 | public override string ToString() 35 | { 36 | return ",read"; 37 | } 38 | 39 | public static readonly StackFunction Instance = new Read().ToStack(); 40 | } 41 | 42 | class IsEof : UnaryFunction 43 | { 44 | protected override Datum eval(Datum arg) 45 | { 46 | return eof.Equals(arg).ToAtom(); 47 | } 48 | 49 | public override string ToString() 50 | { 51 | return ",eof-object?"; 52 | } 53 | 54 | public static readonly StackFunction Instance = new IsEof().ToStack(); 55 | } 56 | 57 | class OpenInputString : UnaryFunction 58 | { 59 | protected override Datum eval(Datum arg) 60 | { 61 | return new Parser(Scanner.Create(arg.CastString())).ToAtom(); 62 | } 63 | 64 | public override string ToString() 65 | { 66 | return ",open-input-string"; 67 | } 68 | 69 | public static readonly StackFunction Instance = new OpenInputString().ToStack(); 70 | } 71 | 72 | class OpenInputStream : UnaryFunction 73 | { 74 | protected override Datum eval(Datum arg) 75 | { 76 | return new Parser(new Scanner((TextReader) arg.CastObject())).ToAtom(); 77 | } 78 | 79 | public override string ToString() 80 | { 81 | return ",open-input-stream"; 82 | } 83 | 84 | public static readonly StackFunction Instance = new OpenInputStream().ToStack(); 85 | } 86 | 87 | public static LexicalEnvironment AddTo(LexicalEnvironment env) 88 | { 89 | env.Define("read", Read.Instance); 90 | env.Define("open-input-string", OpenInputString.Instance); 91 | env.Define("eof-object?", IsEof.Instance); 92 | env.Define("open-input-stream", OpenInputStream.Instance); 93 | return env; 94 | } 95 | } 96 | } 97 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Bootstrap/StandardEnvironment.cs: -------------------------------------------------------------------------------- 1 | using LispEngine.Core; 2 | using LispEngine.Evaluation; 3 | using LispEngine.ReflectionBinding; 4 | using LispEngine.Util; 5 | 6 | namespace LispEngine.Bootstrap 7 | { 8 | public class StandardEnvironment 9 | { 10 | public static LexicalEnvironment Create() 11 | { 12 | var env = CreateSandbox(); 13 | // Adding reflection builtins enables a lisp engine 14 | // to execute any code. 15 | env = ReflectionBuiltins.AddTo(env); 16 | // Add functions for reading files, executing lisp programs 17 | // defined in files. 18 | ResourceLoader.ExecuteResource(env, "LispEngine.Bootstrap.IO.lisp"); 19 | return env; 20 | } 21 | 22 | /** 23 | * Create a "sandbox" environment: the symbols defined in the 24 | * environment don't provide any way for lisp programs to execute 25 | * arbitrary code. 26 | */ 27 | public static LexicalEnvironment CreateSandbox() 28 | { 29 | var env = LexicalEnvironment.Create(); 30 | env = CoreForms.AddTo(env); 31 | env = Builtins.AddTo(env); 32 | return env; 33 | } 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Bootstrap/SymbolFunctions.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Core; 6 | using LispEngine.Datums; 7 | using LispEngine.Evaluation; 8 | 9 | namespace LispEngine.Bootstrap 10 | { 11 | class SymbolFunctions 12 | { 13 | class SymbolToString : UnaryFunction 14 | { 15 | protected override Datum eval(Datum arg) 16 | { 17 | return arg.CastSymbol().Identifier.ToAtom(); 18 | } 19 | } 20 | 21 | class StringToSymbol : UnaryFunction 22 | { 23 | protected override Datum eval(Datum arg) 24 | { 25 | return DatumHelpers.symbol(DatumHelpers.castString(arg)); 26 | } 27 | } 28 | 29 | class GenSym : Function 30 | { 31 | public Datum Evaluate(Datum args) 32 | { 33 | if (!DatumHelpers.nil.Equals(args)) 34 | throw DatumHelpers.error("gensym accepts no arguments"); 35 | return Symbol.GenUnique(); 36 | } 37 | } 38 | 39 | public static LexicalEnvironment Extend(LexicalEnvironment env) 40 | { 41 | env.Define("symbol->string", new SymbolToString().ToStack()); 42 | env.Define("string->symbol", new StringToSymbol().ToStack()); 43 | env.Define("gensym", new GenSym().ToStack()); 44 | return env; 45 | } 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Apply.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class Apply : AbstractStackFunction 11 | { 12 | public static readonly StackFunction Instance = new Apply(); 13 | 14 | private Apply() 15 | { 16 | } 17 | 18 | public override Continuation Evaluate(Continuation c, Datum args) 19 | { 20 | var datumArgs = args.ToArray(); 21 | if (datumArgs.Length != 2) 22 | throw c.error("Apply expects 2 arguments. {0} passed", datumArgs.Length); 23 | var function = datumArgs[0] as StackFunction; 24 | if (function == null) 25 | throw c.error("'{0}' is not a function", datumArgs[0]); 26 | return function.Evaluate(c, datumArgs[1]); 27 | } 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Begin.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class Begin : AbstractFExpression 11 | { 12 | public static readonly FExpression Instance = new Begin(); 13 | 14 | private static Continuation popResult(Continuation c) 15 | { 16 | return c.PopResult(); 17 | } 18 | 19 | public override Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args) 20 | { 21 | var argList = args.ToArray(); 22 | if (argList.Length < 1) 23 | throw c.error("Expected at least 1 expression for begin. Got none."); 24 | // Scope any local definitions. 25 | var localEnv = env.NewFrame(); 26 | var remaining = argList.Reverse().ToArray(); 27 | for (var i = 0; i < remaining.Length; ++i) 28 | { 29 | if (i > 0) 30 | c = c.PushTask(popResult, "Discard result"); 31 | c = c.Evaluate(localEnv, remaining[i]); 32 | } 33 | return c; 34 | } 35 | 36 | public override string ToString() 37 | { 38 | return ",begin"; 39 | } 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/BinaryFunction.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | abstract class BinaryFunction : Function 11 | { 12 | public Datum Evaluate(Datum args) 13 | { 14 | var argDatums = args.ToArray(); 15 | if (argDatums.Length != 2) 16 | throw DatumHelpers.error("Exactly 2 arguments expected"); 17 | return eval(argDatums[0], argDatums[1]); 18 | } 19 | 20 | protected abstract Datum eval(Datum arg1, Datum arg2); 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/CallCC.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class CallCC : AbstractStackFunction 11 | { 12 | public class ContinuationFunction : AbstractStackFunction 13 | { 14 | private readonly Continuation c; 15 | public ContinuationFunction(Continuation c) 16 | { 17 | this.c = c; 18 | } 19 | 20 | public Continuation Continuation 21 | { 22 | get { return c; } 23 | } 24 | 25 | public override Continuation Evaluate(Continuation oldContinuation, Datum args) 26 | { 27 | // Replace the old continuation with the new continuation - but pass in the 28 | // supplied argument as the 'return value' of the new continuation. 29 | var argArray = args.ToArray(); 30 | // We allow calling a "continuation" with 0 args. Such a continuation 31 | // only arises from the error function. 32 | // TODO: we should differentiate the two with an "expected args" member which we can error check. 33 | if (argArray.Length == 0) 34 | return c; 35 | return c.PushResult(argArray[0]); 36 | } 37 | } 38 | 39 | public static StackFunction MakeContinuationFunction(Continuation c) 40 | { 41 | return new ContinuationFunction(c); 42 | } 43 | 44 | public static readonly StackFunction Instance = new CallCC(); 45 | 46 | public override Continuation Evaluate(Continuation c, Datum args) 47 | { 48 | var argArray = args.ToArray(); 49 | if(argArray.Length != 1) 50 | throw DatumHelpers.error("call-cc: expect a single function as an argument. Got {0}", argArray.Length); 51 | var arg = argArray[0]; 52 | var function = arg as StackFunction; 53 | if(function == null) 54 | throw DatumHelpers.error("call-cc: {0} must be a function", arg); 55 | return function.Evaluate(c, DatumHelpers.compound(MakeContinuationFunction(c))); 56 | } 57 | } 58 | } 59 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/CoreForms.cs: -------------------------------------------------------------------------------- 1 | using LispEngine.Datums; 2 | using LispEngine.Evaluation; 3 | using LispEngine.ReflectionBinding; 4 | 5 | namespace LispEngine.Core 6 | { 7 | // Because we have implemented macros as first class objects, 8 | // *all* core forms can be simply be defined in the environment! 9 | public class CoreForms 10 | { 11 | public static LexicalEnvironment AddTo(LexicalEnvironment env) 12 | { 13 | env = env 14 | .Define("log", Log.Instance) 15 | .Define("lambda", Lambda.Instance) 16 | .Define("cons", DelegateFunctions.MakeDatumFunction(DatumHelpers.cons, ",cons")) 17 | .Define("set-car!", DelegateFunctions.MakeDatumFunction(DatumHelpers.setCar, ",set-car!")) 18 | .Define("set-cdr!", DelegateFunctions.MakeDatumFunction(DatumHelpers.setCdr, ",set-cdr!")) 19 | .Define("apply", Apply.Instance) 20 | .Define("eq?", EqualFunctions.Eq) 21 | .Define("equal?", EqualFunctions.Equal) 22 | .Define("quote", Quote.Instance) 23 | .Define("define", Define.Instance) 24 | .Define("set!", Set.Instance) 25 | .Define("begin", Begin.Instance) 26 | .Define("call-with-current-continuation", CallCC.Instance) 27 | .Define("eval", Eval.Instance) 28 | .Define("env", Env.Instance); 29 | env = DebugFunctions.AddTo(env); 30 | env = Macro.AddTo(env); 31 | env = VectorFunctions.AddTo(env); 32 | return env; 33 | } 34 | } 35 | } -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/DebugFunctions.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class DebugFunctions : DelegateFunctions 11 | { 12 | private static Continuation asContinuation(Datum arg) 13 | { 14 | var cfunction = arg as CallCC.ContinuationFunction; 15 | if (cfunction == null) 16 | throw DatumHelpers.error("'{0}' is not a continuation", arg); 17 | return cfunction.Continuation; 18 | } 19 | 20 | private static Datum getEnvironments(Datum arg) 21 | { 22 | var c = asContinuation(arg); 23 | var stack = DatumHelpers.nil; 24 | while (c.Env != null) 25 | { 26 | stack = DatumHelpers.cons(c.Env.ToAtom(), stack); 27 | c = c.PopEnv(); 28 | } 29 | return stack; 30 | } 31 | 32 | private static Datum getTaskDescriptions(Datum arg) 33 | { 34 | var c = asContinuation(arg); 35 | var stack = DatumHelpers.nil; 36 | while (c.Task != null) 37 | { 38 | stack = DatumHelpers.cons(c.Task.ToString().ToAtom(), stack); 39 | c = c.PopTask(); 40 | } 41 | return stack; 42 | } 43 | 44 | private static Datum getPendingResults(Datum arg) 45 | { 46 | var c = asContinuation(arg); 47 | var stack = DatumHelpers.nil; 48 | while (c.Result != null) 49 | { 50 | stack = DatumHelpers.cons(c.Result, stack); 51 | c = c.PopResult(); 52 | } 53 | return stack; 54 | } 55 | 56 | private static Datum getEnv(Datum arg) 57 | { 58 | var c = asContinuation(arg); 59 | return c.Env.ToAtom(); 60 | } 61 | 62 | private static Datum throwMsg(Datum arg) 63 | { 64 | var msg = (String)arg.CastObject(); 65 | throw DatumHelpers.error(msg); 66 | } 67 | 68 | public static LexicalEnvironment AddTo(LexicalEnvironment env) 69 | { 70 | return env.Define("task-descriptions", MakeDatumFunction(getTaskDescriptions, ",task-descriptions")) 71 | .Define("execute-with-error-translator", ExecuteWithErrorTranslator.Instance) 72 | .Define("env-stack", MakeDatumFunction(getEnvironments, ",env-stack")) 73 | .Define("pending-results", MakeDatumFunction(getPendingResults, ",pending-results")) 74 | .Define("throw", MakeDatumFunction(throwMsg, ",throw")) 75 | .Define("get-env", MakeDatumFunction(getEnv, ",get-env")); 76 | } 77 | } 78 | } 79 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Define.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class Define : AbstractFExpression 11 | { 12 | public static readonly FExpression Instance = new Define(); 13 | 14 | public override Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args) 15 | { 16 | var argList = args.ToArray(); 17 | if (argList.Length != 2) 18 | throw c.error("Expected 2 arguments: (define ). Got {0} instead", argList.Length); 19 | var name = argList[0].CastSymbol(); 20 | var expression = argList[1]; 21 | c = c.PushTask( 22 | tc => { env.Define(name, tc.Result); 23 | return tc;}, 24 | "define '{0}'", name); 25 | return c.Evaluate(env, expression); 26 | } 27 | } 28 | } 29 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Env.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class Env : AbstractFExpression 11 | { 12 | public override Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args) 13 | { 14 | return c.PushResult(env.ToAtom()); 15 | } 16 | 17 | public override string ToString() 18 | { 19 | return ",env"; 20 | } 21 | 22 | public static FExpression Instance = new Env(); 23 | } 24 | } 25 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/EqualFunctions.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class EqualFunctions : BinaryFunction 11 | { 12 | public static readonly StackFunction Eq = new EqualFunctions(true).ToStack(); 13 | public static readonly StackFunction Equal = new EqualFunctions(false).ToStack(); 14 | private readonly bool shallow; 15 | public EqualFunctions(bool shallow) 16 | { 17 | this.shallow = shallow; 18 | } 19 | protected override Datum eval(Datum arg1, Datum arg2) 20 | { 21 | if (shallow && 22 | ((arg1 as Pair) != null || 23 | (arg2 as Pair) != null)) 24 | return DatumHelpers.atom(ReferenceEquals(arg1, arg2)); 25 | return DatumHelpers.atom(arg1.Equals(arg2)); 26 | } 27 | 28 | public override string ToString() 29 | { 30 | return shallow ? ",eq?" : ",equal?"; 31 | } 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Eval.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class Eval : AbstractStackFunction 11 | { 12 | public override Continuation Evaluate(Continuation c, Datum args) 13 | { 14 | var argArray = args.ToArray(); 15 | var expression = argArray[0]; 16 | var environment = (LexicalEnvironment) argArray[1].CastObject(); 17 | return c.Evaluate(environment, expression); 18 | } 19 | 20 | public override string ToString() 21 | { 22 | return ",eval"; 23 | } 24 | 25 | public static readonly StackFunction Instance = new Eval(); 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/ExecuteWithErrorTranslator.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | using ErrorHandler = Func; 11 | 12 | /** 13 | * This "builtin" function provides a way to install a 14 | * Lisp function as the handler for what to do when a .Net exception 15 | * is thrown. 16 | */ 17 | class ExecuteWithErrorTranslator : AbstractStackFunction 18 | { 19 | private static ErrorHandler makeErrorHandler(ErrorHandler oldErrorHandler, StackFunction f) 20 | { 21 | // Report the "message" from the exception to the Lisp 22 | // error handling function. 23 | // Ensure that the original error handler is in scope before evaluating the error function - 24 | // otherwise we end up in an infinite loop if there's an error in the error function itself. 25 | return (c, ex) => f.Evaluate(c.PopTask().SetErrorHandler(oldErrorHandler), DatumHelpers.compound(ex.Message.ToAtom(), CallCC.MakeContinuationFunction(c))); 26 | } 27 | 28 | public override Continuation Evaluate(Continuation c, Datum args) 29 | { 30 | var argArray = args.ToArray(); 31 | if (argArray.Length != 2) 32 | throw DatumHelpers.error("Invalid syntax. ArgCount ({0}) != 2. Usage: (execute-with-error-handler )", argArray.Length); 33 | var errorHandler = makeErrorHandler(c.ErrorHandler, (StackFunction)argArray[0]); 34 | var fn = (StackFunction)argArray[1]; 35 | return fn.Evaluate(c.NewErrorHandler(errorHandler), DatumHelpers.compound()); 36 | } 37 | 38 | public override string ToString() 39 | { 40 | return ",execute-with-error-translator"; 41 | } 42 | 43 | public static readonly StackFunction Instance = new ExecuteWithErrorTranslator(); 44 | } 45 | } -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Lambda.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections; 3 | using System.Collections.Generic; 4 | using System.Linq; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | using FrameBinder = Func>; 11 | 12 | internal sealed class Lambda : AbstractFExpression 13 | { 14 | public static readonly FExpression Instance = new Lambda(); 15 | 16 | private Lambda() 17 | { 18 | } 19 | 20 | private sealed class ArgBody 21 | { 22 | public readonly Datum argDatum; 23 | public readonly FrameBinder binding; 24 | public readonly Datum body; 25 | public ArgBody(Datum argDatum, Datum body) 26 | { 27 | this.argDatum = argDatum; 28 | this.binding = LexicalBinder.Create(argDatum); 29 | this.body = body; 30 | } 31 | 32 | public override string ToString() 33 | { 34 | return string.Format("{0} {1}", argDatum, body); 35 | } 36 | } 37 | 38 | private sealed class Closure : AbstractStackFunction 39 | { 40 | private readonly LexicalEnvironment env; 41 | private readonly IEnumerable argBodies; 42 | public Closure(LexicalEnvironment env, IEnumerable argBodies) 43 | { 44 | this.env = env; 45 | this.argBodies = argBodies; 46 | } 47 | 48 | Exception bindError(Datum args) 49 | { 50 | return DatumHelpers.error("Could not bind '{0}' to '{1}'", argList(), args); 51 | } 52 | 53 | private string argList() 54 | { 55 | return string.Join(" or ", argBodies.Select(a => a.argDatum.ToString())); 56 | } 57 | 58 | public override string ToString() 59 | { 60 | return string.Format("(lambda {0})", string.Join(" ", argBodies.Select(x => x.ToString()).ToArray())); 61 | } 62 | 63 | public override Continuation Evaluate(Continuation c, Datum args) 64 | { 65 | foreach (var ab in argBodies) 66 | { 67 | var frameBindings = ab.binding(args); 68 | if (frameBindings == null) 69 | continue; 70 | var closureEnv = env.NewFrame(frameBindings); 71 | return c.Evaluate(closureEnv, ab.body); 72 | } 73 | throw bindError(args); 74 | } 75 | } 76 | 77 | private static Datum evaluate(Continuation c, LexicalEnvironment env, Datum args) 78 | { 79 | var macroArgs = args.ToArray(); 80 | if (macroArgs.Length % 2 != 0) 81 | throw c.error("Invalid macro syntax for lambda. Argument count for '{0}' is not even ({1}). Syntax is (lambda [args body]+)", args, macroArgs.Length); 82 | 83 | var argBodies = new List(); 84 | for (var i = 0; i < macroArgs.Length; i += 2) 85 | { 86 | var closureArgs = macroArgs[i]; 87 | var body = macroArgs[i + 1]; 88 | argBodies.Add(new ArgBody(closureArgs, body)); 89 | } 90 | return new Closure(env, argBodies); 91 | } 92 | 93 | public override Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args) 94 | { 95 | return c.PushResult(evaluate(c, env, args)); 96 | } 97 | } 98 | } 99 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/LexicalBinder.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | using FrameBindings = IStack; 11 | using FrameBinder = Func>; 12 | 13 | using Binder = Func, IStack>; 14 | 15 | class LexicalBinder : DatumHelpers 16 | { 17 | private static Binder matchExact(Datum d) 18 | { 19 | return (arg, frame) => d.Equals(arg) ? frame : null; 20 | } 21 | 22 | private static FrameBindings bindSymbol(Symbol symbol, Datum value, FrameBindings bindings) 23 | { 24 | return bindings.Push(new LexicalEnvironment.Binding(symbol, value)); 25 | } 26 | 27 | private static Binder combine(Binder first, Binder second) 28 | { 29 | return (arg, frame) => 30 | { 31 | var argPair = arg as Pair; 32 | if (argPair == null) 33 | return null; 34 | var e = first(argPair.First, frame); 35 | return e == null ? null : second(argPair.Second, e); 36 | }; 37 | } 38 | 39 | class BinderPartFactory : AbstractVisitor 40 | { 41 | public override Binder defaultCase(Datum d) 42 | { 43 | throw error("'{0}' is not a valid argument list", d); 44 | } 45 | 46 | public override Binder visit(Null n) 47 | { 48 | return (arg, frame) => arg == nil ? frame : null; 49 | } 50 | 51 | public override Binder visit(Symbol s) 52 | { 53 | return (arg, frame) => bindSymbol(s, arg, frame); 54 | } 55 | 56 | public override Binder visit(Pair p) 57 | { 58 | // Quoted instances also form an exact match 59 | if (quote.Equals(p.First)) 60 | { 61 | var quoted = p.Second as Pair; 62 | if (quoted != null) 63 | return matchExact(quoted.First); 64 | } 65 | return combine(p.First.accept(this), p.Second.accept(this)); 66 | } 67 | 68 | public override Binder visit(Atom a) 69 | { 70 | return matchExact(a); 71 | } 72 | } 73 | 74 | public static readonly DatumVisitor Factory = new BinderPartFactory(); 75 | 76 | private static Binder create(Datum d) 77 | { 78 | return d.accept(Factory); 79 | } 80 | 81 | public static FrameBinder Create(Datum argPattern) 82 | { 83 | var binder = create(argPattern); 84 | return arg => binder(arg, LexicalEnvironment.EmptyFrame); 85 | } 86 | } 87 | } 88 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Log.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class Log : UnaryFunction 11 | { 12 | public static readonly StackFunction Instance = new Log().ToStack(); 13 | protected override Datum eval(Datum arg) 14 | { 15 | Console.WriteLine("{0}", arg); 16 | return arg; 17 | } 18 | } 19 | } 20 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Macro.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | /** 11 | * Turns a function into something that 12 | * can be used as a macro. 13 | */ 14 | internal class Macro : DatumHelpers, Function 15 | { 16 | public static readonly StackFunction Instance = new Macro().ToStack(); 17 | public static readonly StackFunction Unmacro = new UnMacro().ToStack(); 18 | 19 | public static LexicalEnvironment AddTo(LexicalEnvironment env) 20 | { 21 | env.Define("unmacro", Unmacro); 22 | env.Define("macro", Instance); 23 | return env; 24 | } 25 | 26 | private sealed class UnMacro : UnaryFunction 27 | { 28 | protected override Datum eval(Datum arg) 29 | { 30 | var macro = arg as MacroClosure; 31 | return macro == null ? nil : macro.Function; 32 | } 33 | } 34 | 35 | private sealed class EvaluateExpansion : Task 36 | { 37 | private readonly MacroClosure macro; 38 | private readonly Pair macroDatum; 39 | 40 | public EvaluateExpansion(MacroClosure macro, Pair macroDatum) 41 | { 42 | this.macro = macro; 43 | this.macroDatum = macroDatum; 44 | } 45 | 46 | public Continuation Perform(Continuation c) 47 | { 48 | // The result datum may be a graph. This makes certain 49 | // optimizations risky. 50 | var expansion = c.Result; 51 | if(macroDatum != null) 52 | { 53 | // Cache macro expansions. In the extremely 54 | // common case of the same macro being used on the 55 | // same Datum, re-use the expansion. 56 | macroDatum.Cache = cons(macro, expansion); 57 | } 58 | return c.PopResult().PopEnv().Evaluate(c.Env, expansion); 59 | } 60 | } 61 | 62 | private class MacroClosure : AbstractFExpression 63 | { 64 | private readonly StackFunction argFunction; 65 | 66 | public StackFunction Function 67 | { 68 | get { return argFunction; } 69 | } 70 | 71 | public MacroClosure(StackFunction argFunction) 72 | { 73 | this.argFunction = argFunction; 74 | } 75 | 76 | public override Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args) 77 | { 78 | var p = args as Pair; 79 | c = c.PushEnv(env).PushTask(new EvaluateExpansion(this, p)); 80 | // Optimization - if this macro has been expanded on this Datum before, 81 | // use the same expansion. 82 | // See "macro-cache-in-datum" unit test for a demonstration of why 83 | // we need to check against "this" also. 84 | if(p != null) 85 | { 86 | var cachedPair = p.Cache as Pair; 87 | if(cachedPair != null && ReferenceEquals(cachedPair.First, this)) 88 | return c.PushResult(cachedPair.Second); 89 | } 90 | c.Statistics.Expansions++; 91 | return argFunction.Evaluate(c, args); 92 | } 93 | 94 | public override string ToString() 95 | { 96 | return string.Format("(,macro {0})", argFunction); 97 | } 98 | } 99 | 100 | public static FExpression ToMacro(StackFunction function) 101 | { 102 | return new MacroClosure(function); 103 | } 104 | 105 | public Datum Evaluate(Datum args) 106 | { 107 | var function = UnaryFunction.GetSingle(args) as StackFunction; 108 | if (function == null) 109 | throw error("Expected function argument"); 110 | return ToMacro(function); 111 | } 112 | } 113 | } 114 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Quote.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class Quote : AbstractFExpression 11 | { 12 | public static readonly FExpression Instance = new Quote(); 13 | 14 | private static Datum evaluate(Continuation c, Datum args) 15 | { 16 | var argList = args.ToArray(); 17 | if (argList.Length != 1) 18 | throw c.error("invalid syntax '{0}'", args); 19 | return argList[0]; 20 | } 21 | 22 | public override Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args) 23 | { 24 | return c.PushResult(evaluate(c, args)); 25 | } 26 | 27 | public override string ToString() 28 | { 29 | return ",quote"; 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/Set.cs: -------------------------------------------------------------------------------- 1 | using System.Collections.Generic; 2 | using System.Linq; 3 | using System.Text; 4 | using LispEngine.Datums; 5 | using LispEngine.Evaluation; 6 | 7 | namespace LispEngine.Core 8 | { 9 | class Set : AbstractFExpression 10 | { 11 | public static readonly FExpression Instance = new Set(); 12 | 13 | public override Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args) 14 | { 15 | var argList = args.ToArray(); 16 | if (argList.Length != 2) 17 | throw c.error("Expected 2 arguments: (set! ). Got {0} instead", argList.Length); 18 | var name = argList[0].CastSymbol(); 19 | var expression = argList[1]; 20 | c = c.PushTask(s => 21 | { 22 | env.Set(name, s.Result); 23 | return s; 24 | }, "set! '{0}'", name); 25 | return c.Evaluate(env, expression); 26 | } 27 | 28 | public override string ToString() 29 | { 30 | return ",set!"; 31 | } 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/UnaryFunction.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | abstract class UnaryFunction : Function 11 | { 12 | public static Datum GetSingle(Datum args) 13 | { 14 | var argArray = args.ToArray(); 15 | if (argArray.Length != 1) 16 | throw DatumHelpers.error("Expected a single argument. Got {0}", argArray.Length); 17 | return argArray[0]; 18 | 19 | } 20 | public Datum Evaluate(Datum args) 21 | { 22 | return eval(GetSingle(args)); 23 | } 24 | 25 | protected abstract Datum eval(Datum arg); 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Core/VectorFunctions.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class VectorFunctions : DatumHelpers 11 | { 12 | private static readonly Datum zero = DatumHelpers.atom(0); 13 | class MakeVector : Function 14 | { 15 | public Datum Evaluate(Datum args) 16 | { 17 | var argArray = args.ToArray(); 18 | if (argArray.Length != 1 && argArray.Length != 2) 19 | throw error("1 or 2 arguments for make-vector"); 20 | var size = argArray[0].CastInt(); 21 | var initial = argArray.Length == 1 ? zero : argArray[1]; 22 | var array = new Datum[size]; 23 | for (int i = 0; i < size; ++i) 24 | array[i] = initial; 25 | return vector(array); 26 | } 27 | 28 | public override string ToString() 29 | { 30 | return ",make-vector"; 31 | } 32 | } 33 | 34 | class VectorConstructor : Function 35 | { 36 | public Datum Evaluate(Datum args) 37 | { 38 | var argArray = args.ToArray(); 39 | return vector(argArray); 40 | } 41 | 42 | public override string ToString() 43 | { 44 | return ",vector"; 45 | } 46 | } 47 | 48 | private static Datum isVector(Datum d) 49 | { 50 | return (d is Vector).ToAtom(); 51 | } 52 | 53 | // Seems crazy that this method does exist somewhere 54 | // in .Net already... Perhaps it does. I could not find it. 55 | private static T[] CreateCopy(T[] elements) 56 | { 57 | var copy = new T[elements.Length]; 58 | Array.Copy(elements, copy, elements.Length); 59 | return copy; 60 | } 61 | 62 | private static Datum vectorSet(Datum v, Datum index, Datum value) 63 | { 64 | return castVector(v).Elements[index.CastInt()] = value; 65 | } 66 | 67 | private static Datum vectorCopy(Datum d) 68 | { 69 | return vector(CreateCopy(castVector(d).Elements)); 70 | } 71 | 72 | private static Datum vectorLength(Datum d) 73 | { 74 | return castVector(d).Elements.Length.ToAtom(); 75 | } 76 | 77 | private static Datum vectorRef(Datum d, Datum index) 78 | { 79 | return castVector(d).Elements[index.CastInt()]; 80 | } 81 | 82 | public static LexicalEnvironment AddTo(LexicalEnvironment env) 83 | { 84 | env.Define("make-vector", new MakeVector().ToStack()); 85 | env.Define("vector", new VectorConstructor().ToStack()); 86 | env.Define("vector?", DelegateFunctions.MakeDatumFunction(isVector, ",vector?")); 87 | env.Define("vector-copy", DelegateFunctions.MakeDatumFunction(vectorCopy, ",vector-copy")); 88 | env.Define("vector-set!", DelegateFunctions.MakeDatumFunction(vectorSet, ",vector-set!")); 89 | env.Define("vector-length", DelegateFunctions.MakeDatumFunction(vectorLength, ",vector-length")); 90 | env.Define("vector-ref", DelegateFunctions.MakeDatumFunction(vectorRef, ",vector-ref")); 91 | return env; 92 | } 93 | } 94 | } 95 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/AbstractVisitor.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Evaluation; 6 | 7 | namespace LispEngine.Datums 8 | { 9 | abstract class AbstractVisitor : DatumVisitor 10 | { 11 | public abstract T defaultCase(Datum d); 12 | 13 | public virtual T visit(Pair p) 14 | { 15 | return defaultCase(p); 16 | } 17 | 18 | public virtual T visit(Atom a) 19 | { 20 | return defaultCase(a); 21 | } 22 | 23 | public virtual T visit(Symbol s) 24 | { 25 | return defaultCase(s); 26 | } 27 | 28 | public virtual T visit(StackFunction s) 29 | { 30 | return defaultCase(s); 31 | } 32 | 33 | public virtual T visit(FExpression s) 34 | { 35 | return defaultCase(s); 36 | } 37 | 38 | public virtual T visit(Null n) 39 | { 40 | return defaultCase(n); 41 | } 42 | 43 | public virtual T visit(Vector v) 44 | { 45 | return defaultCase(v); 46 | } 47 | } 48 | } 49 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/Atom.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.CodeDom; 3 | using System.Collections.Generic; 4 | using System.Diagnostics; 5 | using System.IO; 6 | using System.Linq; 7 | using System.Text; 8 | using Microsoft.CSharp; 9 | 10 | namespace LispEngine.Datums 11 | { 12 | public sealed class Atom : Datum 13 | { 14 | private readonly object value; 15 | 16 | public Atom(object value) 17 | { 18 | this.value = value; 19 | } 20 | 21 | public object Value 22 | { 23 | [DebuggerStepThrough] 24 | get { return value; } 25 | } 26 | 27 | public bool Equals(Atom other) 28 | { 29 | if (ReferenceEquals(null, other)) return false; 30 | if (ReferenceEquals(this, other)) return true; 31 | return Equals(other.value, value); 32 | } 33 | 34 | public override bool Equals(object obj) 35 | { 36 | if (ReferenceEquals(null, obj)) return false; 37 | if (ReferenceEquals(this, obj)) return true; 38 | if (obj.GetType() != typeof (Atom)) return false; 39 | return Equals((Atom) obj); 40 | } 41 | 42 | public override int GetHashCode() 43 | { 44 | return (value != null ? value.GetHashCode() : 0); 45 | } 46 | 47 | public T accept(DatumVisitor visitor) 48 | { 49 | return visitor.visit(this); 50 | } 51 | 52 | public static bool operator ==(Atom left, Atom right) 53 | { 54 | return Equals(left, right); 55 | } 56 | 57 | public static bool operator !=(Atom left, Atom right) 58 | { 59 | return !Equals(left, right); 60 | } 61 | 62 | // http://stackoverflow.com/questions/323640/can-i-convert-a-c-sharp-string-value-to-an-escaped-string-literal 63 | // Seems the simplest approach, although I have no idea how performant it is. 64 | private static readonly CSharpCodeProvider provider = new CSharpCodeProvider(); 65 | private static string ToLiteral(string input) 66 | { 67 | var writer = new StringWriter(); 68 | provider.GenerateCodeFromExpression(new CodePrimitiveExpression(input), writer, null); 69 | return writer.GetStringBuilder().ToString(); 70 | } 71 | 72 | public override string ToString() 73 | { 74 | if (true.Equals(value)) 75 | return "#t"; 76 | if (false.Equals(value)) 77 | return "#f"; 78 | var s = value as string; 79 | if (s != null) 80 | return ToLiteral(s); 81 | return string.Format("{0}", value); 82 | } 83 | } 84 | } 85 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/Datum.cs: -------------------------------------------------------------------------------- 1 | namespace LispEngine.Datums 2 | { 3 | public interface Datum 4 | { 5 | T accept(DatumVisitor visitor); 6 | } 7 | } 8 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/DatumExtensions.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Evaluation; 6 | 7 | namespace LispEngine.Datums 8 | { 9 | public static class DatumExtensions 10 | { 11 | public static IEnumerable Enumerate(this Datum list) 12 | { 13 | return DatumHelpers.enumerate(list); 14 | } 15 | 16 | public static Datum[] ToArray(this Datum list) 17 | { 18 | return list.Enumerate().ToArray(); 19 | } 20 | 21 | public static Datum ToList(this IEnumerable datums) 22 | { 23 | return DatumHelpers.compound(datums.ToArray()); 24 | } 25 | 26 | public static Datum ToAtom(this object o) 27 | { 28 | return DatumHelpers.atom(o); 29 | } 30 | 31 | public static Symbol ToSymbol(this string identifier) 32 | { 33 | return DatumHelpers.symbol(identifier); 34 | } 35 | 36 | public static Symbol CastSymbol(this Datum d) 37 | { 38 | return DatumHelpers.castSymbol(d); 39 | } 40 | 41 | public static string CastString(this Datum d) 42 | { 43 | return DatumHelpers.castString(d); 44 | } 45 | 46 | public static int CastInt(this Datum d) 47 | { 48 | return DatumHelpers.castInt(d); 49 | } 50 | 51 | public static object CastObject(this Datum d) 52 | { 53 | return DatumHelpers.castObject(d); 54 | } 55 | } 56 | } 57 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/DatumHelpers.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Evaluation; 6 | 7 | namespace LispEngine.Datums 8 | { 9 | public class DatumHelpers 10 | { 11 | public static readonly Datum nil = Null.Instance; 12 | 13 | public static readonly Datum quote = symbol("quote"); 14 | public static readonly Datum quasiquote = symbol("quasiquote"); 15 | public static readonly Datum unquote = symbol("unquote"); 16 | public static readonly Datum unquoteSplicing = symbol("unquote-splicing"); 17 | public static readonly Datum dot = symbol("dot"); 18 | public static readonly Datum slash = symbol("slash"); 19 | 20 | public const string quoteAbbreviation = "'"; 21 | public const string quasiquoteAbbreviation = "`"; 22 | public const string splicingAbbreviation = ",@"; 23 | public const string unquoteAbbreviation = ","; 24 | 25 | public static Datum isQuote(string abbreviation) 26 | { 27 | if (abbreviation == unquoteAbbreviation) 28 | return unquote; 29 | if (abbreviation == quasiquoteAbbreviation) 30 | return quasiquote; 31 | if (abbreviation == splicingAbbreviation) 32 | return unquoteSplicing; 33 | if (abbreviation == quoteAbbreviation) 34 | return quote; 35 | return null; 36 | } 37 | 38 | public static string isQuote(Datum d) 39 | { 40 | if (d.Equals(quote)) 41 | return quoteAbbreviation; 42 | if (d.Equals(quasiquote)) 43 | return quasiquoteAbbreviation; 44 | if (d.Equals(unquoteSplicing)) 45 | return splicingAbbreviation; 46 | if (d.Equals(unquote)) 47 | return unquoteAbbreviation; 48 | return null; 49 | } 50 | 51 | public static Exception error(string msg, params object[] args) 52 | { 53 | return new Exception(string.Format(msg, args)); 54 | } 55 | 56 | public static Symbol castSymbol(Datum dt) 57 | { 58 | var symbol = dt as Symbol; 59 | if (symbol == null) 60 | throw new Exception(String.Format("'{0}' is not a symbol", dt)); 61 | return symbol; 62 | } 63 | 64 | public static Symbol symbol(string identifier) 65 | { 66 | return Symbol.GetSymbol(identifier); 67 | } 68 | 69 | public static Pair cons(Datum first, Datum second) 70 | { 71 | return new Pair(first, second); 72 | } 73 | 74 | public static Pair setCar(Datum first, Datum val) 75 | { 76 | var p = castPair(first); 77 | p.First = val; 78 | return p; 79 | } 80 | 81 | public static Pair setCdr(Datum first, Datum val) 82 | { 83 | var p = castPair(first); 84 | p.Second = val; 85 | return p; 86 | } 87 | 88 | public static Datum atomList(params T[] e) 89 | { 90 | return compound(e.AsEnumerable().Select(atom).ToArray()); 91 | } 92 | 93 | public static Datum compound(params Datum[] e) 94 | { 95 | var list = new List(e); 96 | list.Reverse(); 97 | return list.Aggregate(nil, (current, l) => cons(l, current)); 98 | } 99 | 100 | public static Vector vector(params Datum[] elements) 101 | { 102 | return new Vector(elements); 103 | } 104 | 105 | public static Atom atom(T value) 106 | { 107 | return new Atom(value); 108 | } 109 | 110 | private static Pair castPair(Datum d) 111 | { 112 | var pair = d as Pair; 113 | if (pair == null) 114 | throw error("'{0}' is not a pair", d); 115 | return pair; 116 | } 117 | 118 | public static Vector castVector(Datum d) 119 | { 120 | var v = d as Vector; 121 | if (v == null) 122 | throw error("Expected '{0}' to be a vector", d); 123 | return v; 124 | } 125 | 126 | public static Datum car(Datum d) 127 | { 128 | return castPair(d).First; 129 | } 130 | 131 | public static IEnumerable enumerate(Datum list) 132 | { 133 | var next = list; 134 | while(next != nil) 135 | { 136 | var pair = next as Pair; 137 | if(pair == null) 138 | throw new Exception("Not a list"); 139 | next = pair.Second; 140 | yield return pair.First; 141 | } 142 | } 143 | 144 | public static object castObject(Datum d) 145 | { 146 | var a = d as Atom; 147 | if (a == null) 148 | throw error("Expected '{0}' to be an atom, but got '{1}' instead", d, d.GetType().Name); 149 | return a.Value; 150 | } 151 | 152 | public static int castInt(Datum d) 153 | { 154 | var value = castObject(d); 155 | return (int) value; 156 | } 157 | 158 | public static string castString(Datum datum) 159 | { 160 | return (string)castObject(datum); 161 | } 162 | 163 | public static IEnumerable atoms(Datum list) 164 | { 165 | return enumerate(list).Select(castObject); 166 | } 167 | 168 | public static IEnumerable enumerateInts(Datum list) 169 | { 170 | return atoms(list).Select(v => (int) v); 171 | } 172 | 173 | } 174 | } 175 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/DatumVisitor.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Evaluation; 6 | 7 | namespace LispEngine.Datums 8 | { 9 | // The "visitor" pattern provides a raw appromiximation of 10 | // pattern-matching in functional languages. 11 | // It's useful in our case because the fundamental subclasses 12 | // of "Datum" will stay quite fixed but there are many cases 13 | // when we need to execute different behaviour based on the 14 | // type of the Datum. 15 | public interface DatumVisitor 16 | { 17 | T visit(Pair p); 18 | T visit(Atom a); 19 | T visit(Symbol s); 20 | T visit(StackFunction s); 21 | T visit(FExpression s); 22 | T visit(Null n); 23 | T visit(Vector v); 24 | } 25 | } 26 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/Null.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | 6 | namespace LispEngine.Datums 7 | { 8 | public sealed class Null : Datum 9 | { 10 | private Null() 11 | { 12 | } 13 | 14 | public static readonly Datum Instance = new Null(); 15 | 16 | public override int GetHashCode() 17 | { 18 | return 0; 19 | } 20 | 21 | public T accept(DatumVisitor visitor) 22 | { 23 | return visitor.visit(this); 24 | } 25 | 26 | public override bool Equals(object obj) 27 | { 28 | return obj as Null != null; 29 | } 30 | 31 | public override string ToString() 32 | { 33 | return "()"; 34 | } 35 | 36 | 37 | } 38 | } 39 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/Pair.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | 6 | namespace LispEngine.Datums 7 | { 8 | public sealed class Pair : Datum 9 | { 10 | public Datum First { get; set; } 11 | public Datum Second { get; set; } 12 | 13 | public Pair(Datum first, Datum second) 14 | { 15 | this.First = first; 16 | this.Second = second; 17 | } 18 | 19 | public Datum Cache { get; set; } 20 | 21 | /** 22 | * Location of this Pair if it was read from 23 | * a file 24 | */ 25 | public object Location { get; set; } 26 | 27 | private static Pair asPair(Datum d) 28 | { 29 | return d as Pair; 30 | } 31 | 32 | private class Writer 33 | { 34 | private readonly StringBuilder sb = new StringBuilder(); 35 | private Boolean empty = true; 36 | public Writer() 37 | { 38 | sb.Append('('); 39 | } 40 | public void Write(object d) 41 | { 42 | if(!empty) 43 | sb.Append(' '); 44 | sb.Append(d); 45 | empty = false; 46 | } 47 | 48 | public string GetString() 49 | { 50 | sb.Append(')'); 51 | return sb.ToString(); 52 | } 53 | } 54 | 55 | public override string ToString() 56 | { 57 | var abbreviation = DatumHelpers.isQuote(First); 58 | if(abbreviation != null) 59 | { 60 | var quoted = Second as Pair; 61 | if(quoted != null) 62 | return string.Format("{0}{1}", abbreviation, quoted.First); 63 | } 64 | var writer = new Writer(); 65 | Pair tail; 66 | Datum next = this; 67 | while( (tail = asPair(next)) != null) 68 | { 69 | writer.Write(tail.First); 70 | next = tail.Second; 71 | } 72 | if(next != Null.Instance) 73 | { 74 | writer.Write("."); 75 | writer.Write(next); 76 | 77 | } 78 | return writer.GetString(); 79 | } 80 | 81 | public T accept(DatumVisitor visitor) 82 | { 83 | return visitor.visit(this); 84 | } 85 | 86 | public bool Equals(Pair other) 87 | { 88 | if (ReferenceEquals(null, other)) return false; 89 | if (ReferenceEquals(this, other)) return true; 90 | return Equals(other.First, First) && Equals(other.Second, Second); 91 | } 92 | 93 | public override bool Equals(object obj) 94 | { 95 | if (ReferenceEquals(null, obj)) return false; 96 | if (ReferenceEquals(this, obj)) return true; 97 | if (obj.GetType() != typeof (Pair)) return false; 98 | return Equals((Pair) obj); 99 | } 100 | 101 | public override int GetHashCode() 102 | { 103 | unchecked 104 | { 105 | return ((First != null ? First.GetHashCode() : 0)*397) ^ (Second != null ? Second.GetHashCode() : 0); 106 | } 107 | } 108 | 109 | public static bool operator ==(Pair left, Pair right) 110 | { 111 | return Equals(left, right); 112 | } 113 | 114 | public static bool operator !=(Pair left, Pair right) 115 | { 116 | return !Equals(left, right); 117 | } 118 | } 119 | } 120 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/Symbol.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Evaluation; 6 | 7 | namespace LispEngine.Datums 8 | { 9 | public sealed class Symbol : Datum 10 | { 11 | private readonly string identifier; 12 | private readonly int id; 13 | 14 | // These two used for optimizing lookups 15 | public LexicalEnvironment Env { get; set; } 16 | public LexicalEnvironment.Binding CachedBinding { get; set; } 17 | 18 | private Symbol(string identifier, int id) 19 | { 20 | this.identifier = identifier; 21 | this.id = id; 22 | } 23 | 24 | public int ID 25 | { 26 | get { return id; } 27 | } 28 | 29 | public string Identifier 30 | { 31 | get { return identifier; } 32 | } 33 | 34 | public override string ToString() 35 | { 36 | return identifier; 37 | } 38 | 39 | public T accept(DatumVisitor visitor) 40 | { 41 | return visitor.visit(this); 42 | } 43 | 44 | public Symbol clone() 45 | { 46 | return new Symbol(identifier, id); 47 | } 48 | 49 | /* 50 | * Optimize symbol comparison by 51 | * interning all symbols. 52 | */ 53 | class SymbolFactory 54 | { 55 | private int counter; 56 | private readonly IDictionary ids = new Dictionary(); 57 | 58 | private int GetId(string identifier) 59 | { 60 | int id; 61 | if (ids.TryGetValue(identifier, out id)) 62 | return id; 63 | id = ++counter; 64 | ids[identifier] = id; 65 | return id; 66 | } 67 | 68 | public Symbol GetSymbol(string identifier) 69 | { 70 | return new Symbol(identifier, GetId(identifier)); 71 | } 72 | 73 | public Symbol Unique() 74 | { 75 | ++counter; 76 | return new Symbol(string.Format("!!unique-{0}", counter), counter); 77 | } 78 | 79 | private SymbolFactory() 80 | { 81 | } 82 | 83 | private static readonly SymbolFactory instance = new SymbolFactory(); 84 | 85 | public static SymbolFactory Instance 86 | { 87 | get { return instance; } 88 | } 89 | } 90 | 91 | public static Symbol GetSymbol(string identifier) 92 | { 93 | return SymbolFactory.Instance.GetSymbol(identifier); 94 | } 95 | 96 | public static Symbol GenUnique() 97 | { 98 | return SymbolFactory.Instance.Unique(); 99 | } 100 | 101 | public bool Equals(Symbol other) 102 | { 103 | if (ReferenceEquals(null, other)) return false; 104 | if (ReferenceEquals(this, other)) return true; 105 | return other.id == id; 106 | } 107 | 108 | public override bool Equals(object obj) 109 | { 110 | if (ReferenceEquals(null, obj)) return false; 111 | if (ReferenceEquals(this, obj)) return true; 112 | if (obj.GetType() != typeof (Symbol)) return false; 113 | return Equals((Symbol) obj); 114 | } 115 | 116 | public override int GetHashCode() 117 | { 118 | return id; 119 | } 120 | 121 | public static bool operator ==(Symbol left, Symbol right) 122 | { 123 | return Equals(left, right); 124 | } 125 | 126 | public static bool operator !=(Symbol left, Symbol right) 127 | { 128 | return !Equals(left, right); 129 | } 130 | } 131 | } 132 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Datums/Vector.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | 6 | namespace LispEngine.Datums 7 | { 8 | public sealed class Vector : Datum 9 | { 10 | private readonly Datum[] elements; 11 | public Vector(Datum[] elements) 12 | { 13 | this.elements = elements; 14 | } 15 | 16 | public Datum[] Elements 17 | { 18 | get { return elements; } 19 | } 20 | 21 | public T accept(DatumVisitor visitor) 22 | { 23 | return visitor.visit(this); 24 | } 25 | 26 | public override string ToString() 27 | { 28 | var s = new StringBuilder(); 29 | s.Append("#("); 30 | var second = false; 31 | foreach(var d in elements) 32 | { 33 | if (second) 34 | s.Append(' '); 35 | s.Append(d.ToString()); 36 | second = true; 37 | } 38 | s.Append(")"); 39 | return s.ToString(); 40 | } 41 | 42 | public override int GetHashCode() 43 | { 44 | return elements.Aggregate(elements.Length, (current, d) => current*17 + d.GetHashCode()); 45 | } 46 | 47 | public override bool Equals(object obj) 48 | { 49 | var rhs = obj as Vector; 50 | if (rhs == null) 51 | return false; 52 | if (elements.Length != rhs.Elements.Length) 53 | return false; 54 | return !elements.Where((t, i) => !t.Equals(rhs.elements[i])).Any(); 55 | } 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/AbstractFExpression.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | 7 | namespace LispEngine.Evaluation 8 | { 9 | abstract class AbstractFExpression : FExpression 10 | { 11 | public T accept(DatumVisitor visitor) 12 | { 13 | return visitor.visit(this); 14 | } 15 | 16 | public abstract Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args); 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/AbstractStackFunction.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | 7 | namespace LispEngine.Evaluation 8 | { 9 | abstract class AbstractStackFunction : StackFunction 10 | { 11 | public T accept(DatumVisitor visitor) 12 | { 13 | return visitor.visit(this); 14 | } 15 | 16 | public abstract Continuation Evaluate(Continuation c, Datum args); 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/Continuation.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.IO; 3 | using LispEngine.Datums; 4 | 5 | namespace LispEngine.Evaluation 6 | { 7 | using ErrorHandler = Func; 8 | 9 | public class Continuation 10 | { 11 | private readonly Statistics statistics; 12 | private readonly IStack envs; 13 | private readonly IStack tasks; 14 | private readonly IStack results; 15 | private readonly ErrorHandler errorHandler; 16 | 17 | public static Continuation Unhandled(Continuation c, Exception ex) 18 | { 19 | throw new EvaluationException(c, ex); 20 | } 21 | 22 | public static readonly Continuation Empty = Create(new Statistics()); 23 | 24 | public static Continuation Create(Statistics s) 25 | { 26 | return new Continuation(s, Stack.Empty.Push(null), Stack.Empty, Stack.Empty, Unhandled); 27 | } 28 | 29 | private Continuation(Statistics statistics, IStack envs, IStack tasks, IStack results, ErrorHandler errorHandler) 30 | { 31 | this.statistics = statistics; 32 | this.envs = envs; 33 | this.tasks = tasks; 34 | this.results = results; 35 | this.errorHandler = errorHandler; 36 | } 37 | 38 | public Statistics Statistics 39 | { 40 | get { return statistics; } 41 | } 42 | 43 | private Continuation create(IStack newEnvs, IStack newTasks, IStack newResults) 44 | { 45 | return new Continuation(statistics, newEnvs, newTasks, newResults, errorHandler); 46 | } 47 | 48 | private Continuation SetTasks(IStack newTasks) 49 | { 50 | return create(envs, newTasks, results); 51 | } 52 | 53 | private Continuation SetEnvs(IStack newEnvs) 54 | { 55 | return create(newEnvs, tasks, results); 56 | } 57 | 58 | private Continuation SetResults(IStack newResults) 59 | { 60 | return create(envs, tasks, newResults); 61 | } 62 | 63 | public Continuation SetErrorHandler(ErrorHandler newHandler) 64 | { 65 | return new Continuation(statistics, envs, tasks, results, newHandler); 66 | } 67 | 68 | public Continuation PushEnv(LexicalEnvironment env) 69 | { 70 | return SetEnvs(envs.Push(env)); 71 | } 72 | 73 | public Continuation PopEnv() 74 | { 75 | return SetEnvs(envs.Pop()); 76 | } 77 | 78 | public Continuation PushTask(Task task) 79 | { 80 | return SetTasks(tasks.Push(task)); 81 | } 82 | 83 | public Continuation PushTask(Func taskDelegate, string fmt, params object[] args) 84 | { 85 | return PushTask(new DelegateTask(taskDelegate, fmt, args)); 86 | } 87 | 88 | public Continuation PopTask() 89 | { 90 | return SetTasks(tasks.Pop()); 91 | } 92 | 93 | public Continuation PushResult(Datum d) 94 | { 95 | return SetResults(results.Push(d)); 96 | } 97 | 98 | public Continuation PopResult() 99 | { 100 | return SetResults(results.Pop()); 101 | } 102 | 103 | public Task Task 104 | { 105 | get { return tasks.Peek(); } 106 | } 107 | 108 | public Datum Result 109 | { 110 | get { return results.Peek(); } 111 | } 112 | 113 | public LexicalEnvironment Env 114 | { 115 | get { return envs.Peek(); } 116 | } 117 | 118 | public ErrorHandler ErrorHandler 119 | { 120 | get { return errorHandler; } 121 | } 122 | 123 | private static StackFunction toStack(Function f) 124 | { 125 | return f as StackFunction ?? new StackFunctionAdapter(f); 126 | } 127 | 128 | public Continuation Invoke(Function f, Datum args) 129 | { 130 | return toStack(f).Evaluate(this, args); 131 | } 132 | 133 | public Continuation Evaluate(LexicalEnvironment e, Datum expression) 134 | { 135 | return PushEnv(e).PushTask(new EvaluateTask(expression)); 136 | } 137 | 138 | public Continuation NewErrorHandler(ErrorHandler errorHandler) 139 | { 140 | // Set the current error handler to something new, but also 141 | // remember to restore the old error handler once we get past this 142 | // point. 143 | // We can't just keep a 'stack' of error handlers in case the error handling 144 | // function itself doesn't escape by invoking a continuation. 145 | return PushTask(c => c.SetErrorHandler(ErrorHandler), "RestoreErrorHandler").SetErrorHandler(errorHandler); 146 | } 147 | } 148 | 149 | static class ContinuationExtensions 150 | { 151 | public static Exception error(this Continuation c, string msg, params object[] args) 152 | { 153 | return error(c, null, msg, args); 154 | } 155 | 156 | public static Exception error(this Continuation c, Exception cause, string msg, params object[] args) 157 | { 158 | return new Exception(string.Format(msg, args), cause); 159 | } 160 | } 161 | } 162 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/DelegateFunctions.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Core; 6 | using LispEngine.Datums; 7 | 8 | namespace LispEngine.Evaluation 9 | { 10 | /** 11 | * Implementations of StackFunction based on Func delegates. 12 | */ 13 | class DelegateFunctions 14 | { 15 | class UnaryDelegateFunction : UnaryFunction 16 | { 17 | private readonly string name; 18 | private readonly Func funcDelegate; 19 | public UnaryDelegateFunction(string name, Func funcDelegate) 20 | { 21 | this.name = name; 22 | this.funcDelegate = funcDelegate; 23 | } 24 | 25 | protected override Datum eval(Datum arg) 26 | { 27 | var input = arg.CastObject(); 28 | if (!(input is T)) 29 | throw DatumHelpers.error("Expected '{0}' to be of type '{1}'", arg, typeof(T).Name); 30 | return funcDelegate((T)input).ToAtom(); 31 | } 32 | 33 | public override string ToString() 34 | { 35 | return name; 36 | } 37 | } 38 | 39 | 40 | class TernaryDatumDelegateFunction : Function 41 | { 42 | private readonly string name; 43 | private readonly Func funcDelegate; 44 | public TernaryDatumDelegateFunction(string name, Func funcDelegate) 45 | { 46 | this.name = name; 47 | this.funcDelegate = funcDelegate; 48 | } 49 | 50 | 51 | public override string ToString() 52 | { 53 | return name; 54 | } 55 | 56 | public Datum Evaluate(Datum args) 57 | { 58 | var argArray = args.ToArray(); 59 | if (argArray.Length != 3) 60 | throw DatumHelpers.error("{0}: 3 arguments expected, got {1}", name, argArray.Length); 61 | return funcDelegate(argArray[0], argArray[1], argArray[2]); 62 | } 63 | } 64 | 65 | class BinaryDatumDelegateFunction : BinaryFunction 66 | { 67 | private readonly string name; 68 | private readonly Func funcDelegate; 69 | public BinaryDatumDelegateFunction(string name, Func funcDelegate) 70 | { 71 | this.name = name; 72 | this.funcDelegate = funcDelegate; 73 | } 74 | 75 | protected override Datum eval(Datum arg1, Datum arg2) 76 | { 77 | return funcDelegate(arg1, arg2); 78 | } 79 | 80 | public override string ToString() 81 | { 82 | return name; 83 | } 84 | } 85 | 86 | class UnaryDatumDelegateFunction : UnaryFunction 87 | { 88 | private readonly string name; 89 | private readonly Func funcDelegate; 90 | public UnaryDatumDelegateFunction(string name, Func funcDelegate) 91 | { 92 | this.name = name; 93 | this.funcDelegate = funcDelegate; 94 | } 95 | 96 | protected override Datum eval(Datum arg) 97 | { 98 | return funcDelegate(arg); 99 | } 100 | public override string ToString() 101 | { 102 | return name; 103 | } 104 | } 105 | 106 | class AccessorFunction : Function 107 | { 108 | private readonly string name; 109 | private readonly Func accessor; 110 | public AccessorFunction(string name, Func accessor) 111 | { 112 | this.name = name; 113 | this.accessor = accessor; 114 | } 115 | public Datum Evaluate(Datum args) 116 | { 117 | if (!DatumHelpers.nil.Equals(args)) 118 | throw DatumHelpers.error("No arguments expected for function '{0}'", name); 119 | return accessor().ToAtom(); 120 | } 121 | 122 | public override string ToString() 123 | { 124 | return name; 125 | } 126 | } 127 | 128 | public static Datum MakeDatumFunction(Func func, string name) 129 | { 130 | return new UnaryDatumDelegateFunction(name, func).ToStack(); 131 | } 132 | 133 | public static Datum MakeDatumFunction(Func func, string name) 134 | { 135 | return new BinaryDatumDelegateFunction(name, func).ToStack(); 136 | } 137 | 138 | public static Datum MakeDatumFunction(Func func, string name) 139 | { 140 | return new TernaryDatumDelegateFunction(name, func).ToStack(); 141 | } 142 | 143 | 144 | public static Datum MakeFunction(Func func, string name) 145 | { 146 | return new AccessorFunction(name, func).ToStack(); 147 | } 148 | 149 | public static Datum MakeFunction(Func func, string name) 150 | { 151 | return new UnaryDelegateFunction(name, func).ToStack(); 152 | } 153 | } 154 | } 155 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/DelegateTask.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | 6 | namespace LispEngine.Evaluation 7 | { 8 | using TaskDelegate = Func; 9 | 10 | sealed class DelegateTask : Task 11 | { 12 | private readonly string fmt; 13 | private readonly object[] items; 14 | private readonly TaskDelegate taskDelegate; 15 | 16 | public DelegateTask(TaskDelegate taskDelegate, string fmt, object[] items) 17 | { 18 | this.fmt = fmt; 19 | this.items = items; 20 | this.taskDelegate = taskDelegate; 21 | } 22 | 23 | public Continuation Perform(Continuation c) 24 | { 25 | return taskDelegate(c); 26 | } 27 | public override string ToString() 28 | { 29 | return string.Format(fmt, items); 30 | } 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/EvaluateFExpression.cs: -------------------------------------------------------------------------------- 1 | using LispEngine.Core; 2 | using LispEngine.Datums; 3 | 4 | namespace LispEngine.Evaluation 5 | { 6 | class EvaluateFExpression : Task 7 | { 8 | private readonly Datum args; 9 | private readonly LexicalEnvironment env; 10 | 11 | class FExpressionConverter : AbstractVisitor 12 | { 13 | private readonly Continuation c; 14 | public FExpressionConverter(Continuation c) 15 | { 16 | this.c = c; 17 | } 18 | public override FExpression visit(FExpression f) 19 | { 20 | return f; 21 | } 22 | 23 | public override FExpression defaultCase(Datum d) 24 | { 25 | throw c.error("'{0}' is not callable", d); 26 | } 27 | 28 | public override FExpression visit(StackFunction f) 29 | { 30 | return new FunctionExpression(f); 31 | } 32 | } 33 | private static FExpression toFExpression(Continuation c) 34 | { 35 | return c.Result.accept(new FExpressionConverter(c)); 36 | } 37 | 38 | public EvaluateFExpression(Datum args, LexicalEnvironment env) 39 | { 40 | this.args = args; 41 | this.env = env; 42 | } 43 | 44 | public Continuation Perform(Continuation c) 45 | { 46 | var fexpression = toFExpression(c); 47 | return fexpression.Evaluate(c.PopResult(), env, args); 48 | } 49 | 50 | public override string ToString() 51 | { 52 | return string.Format("EvaluateFExpression: {0}", args); 53 | } 54 | } 55 | } 56 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/EvaluateTask.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using LispEngine.Datums; 4 | 5 | namespace LispEngine.Evaluation 6 | { 7 | class EvaluateTask : Task 8 | { 9 | private readonly Datum datum; 10 | 11 | public EvaluateTask(Datum datum) 12 | { 13 | this.datum = datum; 14 | } 15 | 16 | class Visitor : AbstractVisitor 17 | { 18 | private readonly LexicalEnvironment env; 19 | private readonly Continuation c; 20 | public Visitor(Continuation c, LexicalEnvironment env) 21 | { 22 | this.c = c; 23 | this.env = env; 24 | } 25 | public override Continuation visit(Pair p) 26 | { 27 | return c 28 | .PushTask(new EvaluateFExpression(p.Second, env)) 29 | .Evaluate(env, p.First); 30 | } 31 | public override Continuation visit(Symbol s) 32 | { 33 | return c.PushResult(env.Lookup(s)); 34 | } 35 | public override Continuation defaultCase(Datum d) 36 | { 37 | return c.PushResult(d); 38 | } 39 | } 40 | 41 | public Continuation Perform(Continuation c) 42 | { 43 | return datum.accept(new Visitor(c.PopEnv(), c.Env)); 44 | } 45 | 46 | private static object getLocation(Datum d) 47 | { 48 | var pair = d as Pair; 49 | return pair == null ? null : pair.Location; 50 | } 51 | 52 | public override string ToString() 53 | { 54 | return string.Format("Evaluate '{0}' ({1})", datum, getLocation(datum)); 55 | } 56 | } 57 | } 58 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/EvaluationException.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | 6 | namespace LispEngine.Evaluation 7 | { 8 | public class EvaluationException : Exception 9 | { 10 | public EvaluationException(Continuation continuation, Exception ex) 11 | : base("Evaluation failed", ex) 12 | { 13 | this.Continuation = continuation; 14 | } 15 | 16 | public Continuation Continuation { get; private set; } 17 | 18 | public override string StackTrace 19 | { 20 | get { 21 | var sb = new StringBuilder(); 22 | sb.Append("Tasks:\n"); 23 | var c = Continuation; 24 | while(c.Task != null) 25 | { 26 | sb.Append(c.Task.ToString()); 27 | sb.Append("\n"); 28 | c = c.PopTask(); 29 | } 30 | return sb.ToString(); 31 | } 32 | } 33 | } 34 | } 35 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/Evaluator.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using LispEngine.Datums; 4 | 5 | namespace LispEngine.Evaluation 6 | { 7 | public class Evaluator 8 | { 9 | private static Datum Evaluate(Continuation c) 10 | { 11 | while (c.Task != null) 12 | { 13 | try 14 | { 15 | c = c.Task.Perform(c.PopTask()); 16 | c.Statistics.Steps++; 17 | } 18 | catch (Exception ex) 19 | { 20 | c = c.ErrorHandler(c, ex); 21 | } 22 | } 23 | return c.Result; 24 | } 25 | 26 | public Datum Evaluate(LexicalEnvironment env, Datum datum) 27 | { 28 | return Evaluate(new Statistics(), env, datum); 29 | } 30 | 31 | public Datum Evaluate(Statistics statistics, LexicalEnvironment env, Datum datum) 32 | { 33 | env.Statistics = statistics; 34 | var c = Continuation.Create(statistics) 35 | .PushTask(null) 36 | .PushResult(null) 37 | .Evaluate(env, datum); 38 | return Evaluate(c); 39 | } 40 | } 41 | } -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/FExpression.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | 7 | namespace LispEngine.Evaluation 8 | { 9 | /** 10 | * An FExpression is passed the un-evaluated arguments. 11 | * It also has the current environment. It can therefore: 12 | * a) Choose to evaluate which (if any) of the input arguments it likes. 13 | * b) Choose to evaluate the result 14 | * The "first-class" nature of our lisp interpreter relies on the fact 15 | * Pair.First in any compound expression implements (or can be made to implement) 16 | * FExpression 17 | */ 18 | public interface FExpression : Datum 19 | { 20 | Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args); 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/Function.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | 7 | namespace LispEngine.Evaluation 8 | { 9 | // A Function that can be implemented completely outside of the interpreter. 10 | // Used for defining builtins, simple arithmetic, etc. 11 | // An "Function" can be converted into a StackFunction, suitable for 12 | // use in the interpreter, by using the "ToStack" extension method. 13 | public interface Function 14 | { 15 | Datum Evaluate(Datum args); 16 | } 17 | } 18 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/FunctionExpression.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | 8 | namespace LispEngine.Core 9 | { 10 | class FunctionExpression : AbstractFExpression 11 | { 12 | private readonly StackFunction function; 13 | 14 | public FunctionExpression(StackFunction function) 15 | { 16 | this.function = function; 17 | } 18 | 19 | private class InvokeFunction : Task 20 | { 21 | private readonly StackFunction function; 22 | private readonly int argCount; 23 | public InvokeFunction(StackFunction function, int argCount) 24 | { 25 | this.function = function; 26 | this.argCount = argCount; 27 | } 28 | 29 | public Continuation Perform(Continuation c) 30 | { 31 | var argResults = DatumHelpers.nil; 32 | for (var i = 0; i < argCount; ++i) 33 | { 34 | argResults = DatumHelpers.cons(c.Result, argResults); 35 | c = c.PopResult(); 36 | } 37 | return function.Evaluate(c, argResults); 38 | } 39 | 40 | public override string ToString() 41 | { 42 | return string.Format("Invoke '{0}' with {1} args", function, argCount); 43 | } 44 | } 45 | 46 | public override Continuation Evaluate(Continuation c, LexicalEnvironment env, Datum args) 47 | { 48 | var argArray = DatumHelpers.enumerate(args).ToArray(); 49 | Array.Reverse(argArray); 50 | c = c.PushTask(new InvokeFunction(function, argArray.Length)); 51 | return argArray.Aggregate(c, (current, arg) => current.Evaluate(env, arg)); 52 | } 53 | } 54 | } 55 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/IEnvironment.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.IO; 4 | using System.Linq; 5 | using System.Text; 6 | using LispEngine.Datums; 7 | 8 | namespace LispEngine.Evaluation 9 | { 10 | // Abstract Environment implementation which is immutable 11 | // w.r.t the set of names that it defines. 12 | // It's not immutable w.r.t the LexicalBindings that each name has. 13 | public interface IEnvironment 14 | { 15 | bool TryLookup(Symbol identifier, out Datum datum); 16 | void Set(Symbol identifier, Datum newValue); 17 | Symbol ReverseLookup(Datum value); 18 | void dump(TextWriter output); 19 | } 20 | } 21 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/IStack.cs: -------------------------------------------------------------------------------- 1 | namespace LispEngine.Evaluation 2 | { 3 | public interface IStack 4 | { 5 | T Peek(); 6 | IStack Pop(); 7 | IStack Push(T t); 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/LexicalEnvironment.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | 7 | namespace LispEngine.Evaluation 8 | { 9 | using FrameBindings = IStack; 10 | 11 | public class LexicalEnvironment 12 | { 13 | public class Binding 14 | { 15 | // Just for debugging 16 | private readonly Symbol symbol; 17 | private readonly int symbolId; 18 | 19 | public Binding(Symbol symbol, Datum value) 20 | { 21 | this.symbol = symbol; 22 | this.symbolId = symbol.ID; 23 | this.Value = value; 24 | } 25 | 26 | public Datum Value { get; set; } 27 | public int SymbolID { get { return symbolId; } } 28 | public Symbol Symbol { get { return symbol; } } 29 | } 30 | 31 | private Statistics statistics; 32 | private readonly LexicalEnvironment parent; 33 | private IStack bindings; 34 | 35 | private LexicalEnvironment(LexicalEnvironment parent, IStack bindings) 36 | { 37 | this.statistics = parent == null ? null : parent.statistics; 38 | this.parent = parent; 39 | this.bindings = bindings; 40 | } 41 | 42 | public static FrameBindings EmptyFrame = Stack.Empty.Push(null); 43 | 44 | private static LexicalEnvironment newFrame(LexicalEnvironment parent, FrameBindings bindings) 45 | { 46 | return new LexicalEnvironment(parent, bindings); 47 | } 48 | 49 | public Statistics Statistics 50 | { 51 | set { statistics = value; } 52 | } 53 | 54 | public LexicalEnvironment NewFrame(FrameBindings frameBindings) 55 | { 56 | return newFrame(this, frameBindings); 57 | } 58 | 59 | public LexicalEnvironment NewFrame() 60 | { 61 | return NewFrame(EmptyFrame); 62 | } 63 | 64 | public static LexicalEnvironment Create() 65 | { 66 | return newFrame(null, EmptyFrame); 67 | } 68 | 69 | public LexicalEnvironment Define(Symbol name, Datum value) 70 | { 71 | this.bindings = bindings.Push(new Binding(name, value)); 72 | return this; 73 | } 74 | 75 | public LexicalEnvironment Define(string name, Datum binding) 76 | { 77 | return Define(Symbol.GetSymbol(name), binding); 78 | } 79 | 80 | private static Exception undefined(Symbol symbol) 81 | { 82 | return DatumHelpers.error("Undefined symbol '{0}'", symbol); 83 | } 84 | 85 | private Binding findInFrame(int id) 86 | { 87 | var b = bindings; 88 | Binding binding; 89 | while( (binding = b.Peek()) != null) 90 | { 91 | if (binding.SymbolID == id) 92 | return binding; 93 | b = b.Pop(); 94 | } 95 | return null; 96 | } 97 | 98 | private static Binding checkCached(LexicalEnvironment e, Symbol symbol) 99 | { 100 | if (symbol.Env == null) 101 | return null; 102 | while(e != null) 103 | { 104 | if (ReferenceEquals(symbol.Env, e)) 105 | return symbol.CachedBinding; 106 | e = e.parent; 107 | } 108 | return null; 109 | } 110 | 111 | private static Binding findAndCache(LexicalEnvironment e, Symbol symbol) 112 | { 113 | if (e.statistics != null) 114 | e.statistics.Lookups++; 115 | var id = symbol.ID; 116 | while(e != null) 117 | { 118 | var b = e.findInFrame(id); 119 | if (b != null) 120 | { 121 | symbol.Env = e; 122 | return (symbol.CachedBinding = b); 123 | } 124 | e = e.parent; 125 | } 126 | throw undefined(symbol); 127 | } 128 | 129 | public Binding Find(Symbol symbol) 130 | { 131 | return checkCached(this, symbol) ?? findAndCache(this, symbol); 132 | } 133 | 134 | public void Set(Symbol symbol, Datum value) 135 | { 136 | Find(symbol).Value = value; 137 | } 138 | 139 | public Datum Lookup(Symbol symbol) 140 | { 141 | return Find(symbol).Value; 142 | } 143 | } 144 | } 145 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/Stack.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | 6 | namespace LispEngine.Evaluation 7 | { 8 | sealed class Stack : IStack 9 | { 10 | private sealed class EmptyStack : IStack 11 | { 12 | public T Peek() 13 | { 14 | throw new Exception("Empty stack"); 15 | } 16 | 17 | public IStack Pop() 18 | { 19 | throw new Exception("Empty stack"); 20 | } 21 | 22 | public IStack Push(T t) 23 | { 24 | return new Stack(t, this); 25 | } 26 | } 27 | 28 | public static readonly IStack Empty = new EmptyStack(); 29 | 30 | private readonly T head; 31 | private readonly IStack tail; 32 | 33 | private Stack(T head, IStack tail) 34 | { 35 | this.head = head; 36 | this.tail = tail; 37 | } 38 | public T Peek() 39 | { 40 | return head; 41 | } 42 | 43 | public IStack Pop() 44 | { 45 | return tail; 46 | } 47 | 48 | public IStack Push(T t) 49 | { 50 | return new Stack(t, this); 51 | } 52 | } 53 | } 54 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/StackFunction.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | 7 | namespace LispEngine.Evaluation 8 | { 9 | public interface StackFunction : Datum 10 | { 11 | Continuation Evaluate(Continuation s, Datum args); 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/StackFunctionAdapter.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | 7 | namespace LispEngine.Evaluation 8 | { 9 | sealed class StackFunctionAdapter : AbstractStackFunction 10 | { 11 | private readonly Function function; 12 | public StackFunctionAdapter(Function function) 13 | { 14 | this.function = function; 15 | } 16 | 17 | public override Continuation Evaluate(Continuation c, Datum args) 18 | { 19 | return c.PushResult(function.Evaluate(args)); 20 | } 21 | 22 | public override string ToString() 23 | { 24 | return function.ToString(); 25 | } 26 | } 27 | 28 | static class FunctionExtensions 29 | { 30 | public static StackFunction ToStack(this Function f) 31 | { 32 | return new StackFunctionAdapter(f); 33 | } 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/Statistics.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Diagnostics; 4 | using System.Linq; 5 | using System.Text; 6 | using LispEngine.Core; 7 | using LispEngine.Datums; 8 | 9 | namespace LispEngine.Evaluation 10 | { 11 | /** 12 | * Used by the interpreter to update statistics about the run time. 13 | */ 14 | public class Statistics 15 | { 16 | public int Steps { get; set; } 17 | public int Expansions { get; set; } 18 | public int Lookups { get; set; } 19 | 20 | public override string ToString() 21 | { 22 | return string.Format("Steps: {0} Expansions: {1} Lookups: {2}", Steps, Expansions, Lookups); 23 | } 24 | 25 | public Statistics() 26 | { 27 | } 28 | 29 | public Statistics(Statistics s) 30 | { 31 | this.Steps = s.Steps; 32 | this.Expansions = s.Expansions; 33 | this.Lookups = s.Lookups; 34 | } 35 | 36 | public Statistics Delta(Statistics prev) 37 | { 38 | return new Statistics {Steps = Steps - prev.Steps, Expansions = Expansions - prev.Expansions, Lookups = Lookups - prev.Lookups}; 39 | } 40 | 41 | public Statistics Snapshot() 42 | { 43 | return new Statistics(this); 44 | } 45 | 46 | // This is a bit hacky - can't figure out a better way to "supply" the statistics 47 | // object yet. Basically, I want to expose "get-counter" to Lisp, but not "statistics" 48 | // itself... I guess. 49 | public LexicalEnvironment AddTo(LexicalEnvironment env) 50 | { 51 | env.Define("!get-statistics", DelegateFunctions.MakeFunction(Snapshot, "!get-statistics")); 52 | env.Define("!get-statistics-delta", DelegateFunctions.MakeFunction(Delta, "!get-statistics-delta")); 53 | return env; 54 | } 55 | } 56 | } 57 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Evaluation/Task.cs: -------------------------------------------------------------------------------- 1 | using System.Collections.Generic; 2 | 3 | namespace LispEngine.Evaluation 4 | { 5 | public interface Task 6 | { 7 | Continuation Perform(Continuation c); 8 | } 9 | } 10 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Lexing/Token.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | 6 | namespace LispEngine.Lexing 7 | { 8 | public sealed class Token 9 | { 10 | private readonly TokenType type; 11 | private readonly string contents; 12 | 13 | public Token(TokenType type, string contents) 14 | { 15 | this.type = type; 16 | this.contents = contents; 17 | } 18 | 19 | public string Contents 20 | { 21 | get { return contents; } 22 | } 23 | 24 | public TokenType Type 25 | { 26 | get { return type; } 27 | } 28 | 29 | public override bool Equals(object obj) 30 | { 31 | if (ReferenceEquals(null, obj)) return false; 32 | if (ReferenceEquals(this, obj)) return true; 33 | if (obj.GetType() != typeof(Token)) return false; 34 | return Equals((Token)obj); 35 | } 36 | 37 | public bool Equals(Token other) 38 | { 39 | if (ReferenceEquals(null, other)) return false; 40 | if (ReferenceEquals(this, other)) return true; 41 | return Equals(other.type, type) && Equals(other.contents, contents); 42 | } 43 | 44 | public override int GetHashCode() 45 | { 46 | unchecked 47 | { 48 | return (type.GetHashCode() * 397) ^ (contents != null ? contents.GetHashCode() : 0); 49 | } 50 | } 51 | 52 | public override string ToString() 53 | { 54 | return string.Format("{0} ({1})", type, contents); 55 | } 56 | } 57 | 58 | } 59 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Lexing/TokenType.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | 6 | namespace LispEngine.Lexing 7 | { 8 | public enum TokenType 9 | { 10 | Space, 11 | Symbol, 12 | Integer, 13 | Double, 14 | String, 15 | Open, 16 | VectorOpen, 17 | Close, 18 | Dot, 19 | Boolean, 20 | Quote, 21 | Comment 22 | } 23 | } 24 | -------------------------------------------------------------------------------- /Lisp/LispEngine/LispEngine.csproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Debug 5 | AnyCPU 6 | 8.0.30703 7 | 2.0 8 | {81EE52DF-F912-4FE5-973C-262762CA3B99} 9 | Library 10 | Properties 11 | LispEngine 12 | LispEngine 13 | v4.0 14 | 512 15 | 16 | 17 | true 18 | full 19 | false 20 | bin\Debug\ 21 | DEBUG;TRACE 22 | prompt 23 | 4 24 | 25 | 26 | pdbonly 27 | true 28 | bin\Release\ 29 | TRACE 30 | prompt 31 | 4 32 | 33 | 34 | 35 | 36 | 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | 61 | 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 102 | 103 | 104 | 105 | 106 | 107 | 108 | 109 | PreserveNewest 110 | 111 | 112 | 113 | 114 | 115 | 116 | 117 | 118 | 119 | 120 | 121 | 122 | 123 | 130 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Parsing/ParseException.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | 6 | namespace LispEngine.Parsing 7 | { 8 | public class ParseException : Exception 9 | { 10 | public ParseException(string fmt) 11 | : base(fmt) 12 | { 13 | } 14 | } 15 | } 16 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Parsing/Parser.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using LispEngine.Lexing; 7 | 8 | namespace LispEngine.Parsing 9 | { 10 | public sealed class Parser : DatumHelpers 11 | { 12 | private readonly Scanner s; 13 | private IEnumerator tokens; 14 | private Token next; 15 | public Parser(Scanner s) 16 | { 17 | this.s = s; 18 | initTokens(s.Scan()); 19 | } 20 | 21 | private void initTokens(IEnumerable tokenStream) 22 | { 23 | // Skip whitespace and comments 24 | tokens = tokenStream.Where(token => token.Type != TokenType.Space && token.Type != TokenType.Comment).GetEnumerator(); 25 | } 26 | 27 | private void readNext() 28 | { 29 | try 30 | { 31 | next = tokens.MoveNext() ? tokens.Current : null; 32 | } 33 | catch (Exception) 34 | { 35 | // If an exception is encountered scanning, 36 | // re-initialize the enumerator (as soon as MoveNext 37 | // throws an exception the previous enumerator 38 | // appears to switch to 'EOF'). 39 | // This is to support recovery from typos in the REPL. 40 | initTokens(s.Recover()); 41 | throw; 42 | } 43 | } 44 | 45 | private ParseException fail(String fmt, params object[] args) 46 | { 47 | return s.fail(fmt, args); 48 | } 49 | 50 | private void expectNext(string what) 51 | { 52 | readNext(); 53 | if(next == null) 54 | throw fail("Expected '{0}'", what); 55 | } 56 | 57 | // Create a "special form" for a symbol that has either "." or "/" inside it. 58 | private static Datum buildSymbolForm(Datum name, IEnumerable contents) 59 | { 60 | // "prefix" with a 'dot' so that higher level macros can interpret it. 61 | // This means you can't have normal symbols containing dots, which is a 62 | // small price to pay IMO. 63 | var args = compound(contents.Select(c => c == "" ? nil : parseSymbol(c)).ToArray()); 64 | return cons(name, args); 65 | } 66 | 67 | // Maybe this splitting should go in the Lexer but 68 | // it's easier to handle it here. We interpret 69 | // "." and "/" especially. This is used to support 70 | // convenient .Net method syntax. 71 | private static Datum parseSymbol(string identifier) 72 | { 73 | // "." has "higher" precedence than "/" 74 | // so 75 | // a.b/c is parsed into 76 | // (slash (dot a b)) 77 | // rather than 78 | // (dot (a (slash b c))) 79 | // We only expand slash if it's actually separating 80 | // something else. Standalone slash stays as is. 81 | var slashSplit = identifier.Split('/'); 82 | if(slashSplit.Length > 1 && slashSplit.Any(c => c.Length > 0)) 83 | return buildSymbolForm(slash, slashSplit); 84 | var split = identifier.Split('.'); 85 | if (split.Length > 1) 86 | return buildSymbolForm(dot, split); 87 | return symbol(identifier); 88 | } 89 | 90 | private Datum symbol() 91 | { 92 | if (next.Type == TokenType.Symbol) 93 | { 94 | return parseSymbol(next.Contents); 95 | } 96 | return null; 97 | } 98 | 99 | private Datum readCdr() 100 | { 101 | expectNext(")"); 102 | var cdr = expression(); 103 | expectNext(")"); 104 | if (next.Type != TokenType.Close) 105 | throw fail("more than one item found after dot (.)"); 106 | return cdr; 107 | } 108 | 109 | private Datum vectorExpr() 110 | { 111 | if (next.Type != TokenType.VectorOpen) 112 | return null; 113 | readNext(); 114 | var elements = new List(); 115 | while (next.Type != TokenType.Close) 116 | { 117 | elements.Add(expression()); 118 | expectNext(")"); 119 | } 120 | return vector(elements.ToArray()); 121 | } 122 | 123 | private Datum compound() 124 | { 125 | if (next.Type != TokenType.Open) 126 | return null; 127 | readNext(); 128 | var elements = new List(); 129 | var cdr = nil; 130 | while(next.Type != TokenType.Close) 131 | { 132 | if (elements.Count > 0 && next.Type == TokenType.Dot) 133 | { 134 | cdr = readCdr(); 135 | break; 136 | } 137 | elements.Add(expression()); 138 | expectNext(")"); 139 | } 140 | elements.Reverse(); 141 | var result = elements.Aggregate(cdr, (current, d) => cons(d, current)); 142 | var resultPair = result as Pair; 143 | if(resultPair != null) 144 | resultPair.Location = string.Format("{0}:{1}", s.Filename, s.LineNumber); 145 | return result; 146 | } 147 | 148 | // Remove the '"' delimiters surrounding the token that came 149 | // back from the lexer. Also 'unescape' any backslashes. 150 | private static string unescape(string s) 151 | { 152 | // Remove surrounding quotes 153 | s = s.Substring(1, s.Length - 2); 154 | // Regex.Unescape solves the problem of converting \n, \t etc 155 | // for us. 156 | return System.Text.RegularExpressions.Regex.Unescape(s); 157 | } 158 | 159 | private Datum atom() 160 | { 161 | if (next.Type == TokenType.Integer) 162 | return atom(int.Parse(next.Contents)); 163 | if (next.Type == TokenType.Double) 164 | return atom(double.Parse(next.Contents)); 165 | if(next.Type == TokenType.Boolean) 166 | return atom(next.Contents.ToLower().Equals("#t")); 167 | if (next.Type == TokenType.String) 168 | return atom(unescape(next.Contents)); 169 | return null; 170 | } 171 | 172 | 173 | private Datum quotedExpression() 174 | { 175 | if (next.Type != TokenType.Quote) 176 | return null; 177 | var symbol = isQuote(next.Contents); 178 | if(symbol != null) 179 | { 180 | var expression = parse(); 181 | return cons(symbol, compound(expression)); 182 | } 183 | return null; 184 | } 185 | 186 | // Based on the token that was just read, turn it into an expression 187 | private Datum expression() 188 | { 189 | Datum d; 190 | if ((d = quotedExpression()) != null) 191 | return d; 192 | if ((d = symbol()) != null) 193 | return d; 194 | if ((d = atom()) != null) 195 | return d; 196 | if ((d = vectorExpr()) != null) 197 | return d; 198 | if ((d = compound()) != null) 199 | return d; 200 | throw fail("Unexpected token: {0}", next); 201 | } 202 | 203 | public Datum parse() 204 | { 205 | readNext(); 206 | return Eof ? null : expression(); 207 | } 208 | 209 | private bool Eof 210 | { 211 | get 212 | { 213 | return next == null; 214 | } 215 | } 216 | } 217 | } 218 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Properties/AssemblyInfo.cs: -------------------------------------------------------------------------------- 1 | using System.Reflection; 2 | using System.Runtime.CompilerServices; 3 | using System.Runtime.InteropServices; 4 | 5 | // General Information about an assembly is controlled through the following 6 | // set of attributes. Change these attribute values to modify the information 7 | // associated with an assembly. 8 | [assembly: AssemblyTitle("LispEngine")] 9 | [assembly: AssemblyDescription("")] 10 | [assembly: AssemblyConfiguration("")] 11 | [assembly: AssemblyCompany("")] 12 | [assembly: AssemblyProduct("LispEngine")] 13 | [assembly: AssemblyCopyright("Copyright © 2012")] 14 | [assembly: AssemblyTrademark("")] 15 | [assembly: AssemblyCulture("")] 16 | 17 | // Setting ComVisible to false makes the types in this assembly not visible 18 | // to COM components. If you need to access a type in this assembly from 19 | // COM, set the ComVisible attribute to true on that type. 20 | [assembly: ComVisible(false)] 21 | 22 | // The following GUID is for the ID of the typelib if this project is exposed to COM 23 | [assembly: Guid("f24f5794-43f2-473b-a8a8-2ea07ddcc8d2")] 24 | 25 | // Version information for an assembly consists of the following four values: 26 | // 27 | // Major Version 28 | // Minor Version 29 | // Build Number 30 | // Revision 31 | // 32 | // You can specify all the values or you can default the Build and Revision Numbers 33 | // by using the '*' as shown below: 34 | // [assembly: AssemblyVersion("1.0.*")] 35 | [assembly: AssemblyVersion("1.0.0.0")] 36 | [assembly: AssemblyFileVersion("1.0.0.0")] 37 | -------------------------------------------------------------------------------- /Lisp/LispEngine/ReflectionBinding/ReflectionBuiltins.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Reflection; 5 | using System.Text; 6 | using LispEngine.Core; 7 | using LispEngine.Datums; 8 | using LispEngine.Evaluation; 9 | using LispEngine.Util; 10 | 11 | namespace LispEngine.ReflectionBinding 12 | { 13 | class ReflectionBuiltins 14 | { 15 | private static object unwrapDatum(Datum d) 16 | { 17 | var atom = d as Atom; 18 | if (atom != null) 19 | return atom.Value; 20 | // For now, assume that if anything other than atom is 21 | // passed into the .Net layer then the target function 22 | // actually expects a Datum. 23 | return d; 24 | } 25 | 26 | private static object[] unwrap(IEnumerable datums) 27 | { 28 | return datums.Select(unwrapDatum).ToArray(); 29 | } 30 | 31 | class InstanceMethod : Function 32 | { 33 | private readonly string name; 34 | public InstanceMethod(string name) 35 | { 36 | this.name = name; 37 | } 38 | 39 | public Datum Evaluate(Datum args) 40 | { 41 | var argArray = args.ToArray(); 42 | 43 | var target = unwrapDatum(argArray[0]); 44 | var methodArgs = unwrap(args.Enumerate().Skip(1)); 45 | var result = target.GetType().InvokeMember(name, BindingFlags.Default | BindingFlags.InvokeMethod, null, target, methodArgs); 46 | return result.ToAtom(); 47 | } 48 | 49 | public override string ToString() 50 | { 51 | return string.Format(".{0}", name); 52 | } 53 | } 54 | 55 | class StaticMethod : Function 56 | { 57 | private readonly Type type; 58 | private readonly string methodName; 59 | public StaticMethod(Type type, string methodName) 60 | { 61 | this.type = type; 62 | this.methodName = methodName; 63 | } 64 | 65 | public Datum Evaluate(Datum args) 66 | { 67 | var methodArgs = unwrap(args.Enumerate()); 68 | var result = type.InvokeMember(methodName, 69 | BindingFlags.Public | BindingFlags.InvokeMethod | BindingFlags.Static, 70 | null, null, methodArgs); 71 | return result == null ? Null.Instance : DatumHelpers.atom(result); 72 | } 73 | 74 | public override string ToString() 75 | { 76 | return string.Format("{0}.{1}", type.FullName, methodName); 77 | } 78 | } 79 | 80 | class New : Function 81 | { 82 | public Datum Evaluate(Datum args) 83 | { 84 | var argsArray = args.ToArray(); 85 | if(argsArray.Length < 1) 86 | throw DatumHelpers.error("No type specified for 'new'"); 87 | 88 | var type = (Type)argsArray[0].CastObject(); 89 | var constructorArgs = argsArray.Skip(1).Select(DatumHelpers.castObject).ToArray(); 90 | var instance = Activator.CreateInstance(type, constructorArgs); 91 | return instance.ToAtom(); 92 | } 93 | 94 | public override string ToString() 95 | { 96 | return ",new"; 97 | } 98 | } 99 | 100 | class WrapAtom : UnaryFunction 101 | { 102 | protected override Datum eval(Datum arg) 103 | { 104 | return arg.ToAtom(); 105 | } 106 | } 107 | 108 | private static Datum MakeInstanceMethod(Datum arg) 109 | { 110 | return new InstanceMethod(arg.CastString()).ToStack(); 111 | } 112 | 113 | private static Datum GetStaticMethod(Datum type, Datum method) 114 | { 115 | return new StaticMethod((Type) type.CastObject(), method.CastString()).ToStack(); 116 | } 117 | 118 | 119 | // Thanks to http://stackoverflow.com/questions/2367652/how-type-gettype-works-when-given-partially-qualified-type-name 120 | // for this: 121 | public static Type GetTypeEx(string fullTypeName) 122 | { 123 | var type = Type.GetType(fullTypeName); 124 | if (type != null) 125 | return type; 126 | var assembly = AppDomain.CurrentDomain.GetAssemblies().FirstOrDefault(a => a.GetType(fullTypeName) != null); 127 | if(assembly != null) 128 | return assembly.GetType(fullTypeName); 129 | throw DatumHelpers.error("Could not locate type '{0}' in any of the {1} currently loaded assemblies", 130 | fullTypeName, AppDomain.CurrentDomain.GetAssemblies().Length); 131 | } 132 | 133 | class GetTypeFunction : Function 134 | { 135 | public Datum Evaluate(Datum args) 136 | { 137 | var argArray = args.ToArray(); 138 | var names = argArray.Select(x => x.CastString()).ToArray(); 139 | var fullname = string.Join(".", names); 140 | return GetTypeEx(fullname).ToAtom(); 141 | } 142 | 143 | public override string ToString() 144 | { 145 | return ",get-type"; 146 | } 147 | } 148 | 149 | public static LexicalEnvironment AddTo(LexicalEnvironment env) 150 | { 151 | // Invoke a given instance method on an object 152 | env.Define("make-instance-method", DelegateFunctions.MakeDatumFunction(MakeInstanceMethod, ",make-instance-method")); 153 | env.Define("get-static-method", DelegateFunctions.MakeDatumFunction(GetStaticMethod, ",get-static-method")); 154 | env.Define("get-type", new GetTypeFunction().ToStack()); 155 | env.Define("new", new New().ToStack()); 156 | env.Define("atom", new WrapAtom().ToStack()); 157 | // Define "dot" and "slash" as a macros which allow us to use 158 | // Clojure-style syntax for invoking and referring to methods. 159 | ResourceLoader.ExecuteResource(env, "LispEngine.ReflectionBinding.ReflectionBuiltins.lisp"); 160 | return env; 161 | } 162 | } 163 | } 164 | -------------------------------------------------------------------------------- /Lisp/LispEngine/ReflectionBinding/ReflectionBuiltins.lisp: -------------------------------------------------------------------------------- 1 | ; The reader reads ".Equals" as "(dot () Equals)". 2 | ; Here, we expand "dot" as a macro. 3 | ; So we end up with: 4 | ; (.Equals "one" "two") => 5 | ; ((dot '() Equals) "one" "two") => 6 | ; ((make-instance-method "Equals") "one" "two") 7 | 8 | ; System.Console => 9 | ; (dot System Console) => 10 | ; (get-type "System" "Console") 11 | (define-macro dot args 12 | (match args 13 | (() method) 14 | `(,make-instance-method ,(symbol->string method)) 15 | name-parts 16 | `(,get-type ,@(mapcar symbol->string name-parts)))) 17 | 18 | ; System.Console/WriteLine => 19 | ; (slash (dot System Console) WriteLine) => 20 | ; (get-static-method (get-type "System" "Console") "WriteLine") 21 | (define-macro slash (type method) 22 | `(,get-static-method ,type ,(symbol->string method))) 23 | -------------------------------------------------------------------------------- /Lisp/LispEngine/Util/ResourceLoader.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.IO; 4 | using System.Linq; 5 | using System.Reflection; 6 | using System.Text; 7 | using LispEngine.Datums; 8 | using LispEngine.Evaluation; 9 | using LispEngine.Lexing; 10 | using LispEngine.Parsing; 11 | 12 | namespace LispEngine.Util 13 | { 14 | public class ResourceLoader 15 | { 16 | public static IEnumerable ReadDatums(string resourceFile) 17 | { 18 | return ReadDatums(Assembly.GetCallingAssembly(), resourceFile); 19 | } 20 | 21 | public static IEnumerable ReadDatums(Assembly assembly, string resourceFile) 22 | { 23 | var stream = assembly.GetManifestResourceStream(resourceFile); 24 | if (stream == null) 25 | throw new Exception(string.Format("Unable to find '{0}' embedded resource", resourceFile)); 26 | var s = new Scanner(new StreamReader(stream)) { Filename = resourceFile }; 27 | var p = new Parser(s); 28 | Datum d; 29 | while ((d = p.parse()) != null) 30 | { 31 | yield return d; 32 | } 33 | } 34 | 35 | public static void ExecuteResource(LexicalEnvironment env, string resourceFile) 36 | { 37 | ExecuteResource(new Statistics(), Assembly.GetCallingAssembly(), env, resourceFile); 38 | } 39 | 40 | /** 41 | * Used for bootstrapping various .lisp files into the environment. 42 | */ 43 | public static void ExecuteResource(Statistics statistics, Assembly assembly, LexicalEnvironment env, string resourceFile) 44 | { 45 | var evaluator = new Evaluator(); 46 | foreach (var d in ReadDatums(assembly, resourceFile)) 47 | evaluator.Evaluate(statistics, env, d); 48 | } 49 | } 50 | } 51 | -------------------------------------------------------------------------------- /Lisp/LispTests/Datums/DatumTest.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using System.Text; 5 | using LispEngine.Datums; 6 | using NUnit.Framework; 7 | 8 | namespace LispTests.Datums 9 | { 10 | [TestFixture] 11 | class DatumTest : DatumHelpers 12 | { 13 | private static void check(string s, Datum d) 14 | { 15 | Assert.AreEqual(s, d.ToString()); 16 | } 17 | [Test] 18 | public void testPairToString() 19 | { 20 | var p = cons(atom(5), atom(6)); 21 | check("(5 . 6)", p); 22 | } 23 | 24 | [Test] 25 | public void testListToString() 26 | { 27 | var l = atomList(5, 6); 28 | check("(5 6)", l); 29 | } 30 | 31 | [Test] 32 | public void testLongerListToString() 33 | { 34 | var l = atomList(5, 6, 7); 35 | check("(5 6 7)", l); 36 | } 37 | 38 | 39 | [Test] 40 | public void testEmptyListToString() 41 | { 42 | check("()", nil); 43 | } 44 | 45 | [Test] 46 | public void testImproperListToString() 47 | { 48 | check("(5 6 . 7)", cons(atom(5), cons(atom(6), atom(7)))); 49 | } 50 | 51 | [Test] 52 | public void testBooleanToString() 53 | { 54 | check("#t", atom(true)); 55 | check("#f", atom(false)); 56 | } 57 | 58 | [Test] 59 | public void testAtomToString() 60 | { 61 | check("\"hello\"", atom("hello")); 62 | } 63 | 64 | [Test] 65 | public void testEscapedStringAtomToString() 66 | { 67 | check("\"hello\\t\\nworld\"", atom("hello\t\nworld")); 68 | } 69 | 70 | [Test] 71 | public void testQuoteToString() 72 | { 73 | check("'5", compound(quote, atom(5))); 74 | } 75 | 76 | [Test] 77 | public void testQuotedListToString() 78 | { 79 | check("'(1 2 3)", compound(quote, atomList(1, 2, 3))); 80 | } 81 | 82 | [Test] 83 | public void testUnquoteToString() 84 | { 85 | check(",3", compound(unquote, atom(3))); 86 | } 87 | 88 | [Test] 89 | public void testQuasiQuoteToString() 90 | { 91 | check("`3", compound(quasiquote, atom(3))); 92 | } 93 | 94 | [Test] 95 | public void testSplicingToString() 96 | { 97 | check(",@3", compound(unquoteSplicing, atom(3))); 98 | } 99 | 100 | 101 | [Test] 102 | public void testDatumEnumerate() 103 | { 104 | var five = atom("5"); 105 | var listfive = compound(five); 106 | var l = enumerate(listfive); 107 | Assert.AreEqual(1, l.Count()); 108 | 109 | var listfivefive = compound(five, five); 110 | l = enumerate(listfivefive); 111 | Assert.AreEqual(2, l.Count()); 112 | } 113 | 114 | } 115 | } 116 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/AmbTests.lisp: -------------------------------------------------------------------------------- 1 | (setup 2 | (define amb (make-amb-macro throw)) 3 | (define assert (make-assert amb))) 4 | (tests 5 | 6 | ; This example came from 7 | ; http://matt.might.net/articles/programming-with-continuations--exceptions-backtracking-search-threads-generators-coroutines/ 8 | (ambTest-Pythagorean (4 3 5) 9 | (begin 10 | (with (a (amb 1 2 3 4 5 6 7) 11 | b (amb 1 2 3 4 5 6 7) 12 | c (amb 1 2 3 4 5 6 7)) 13 | ; We only want pythagorean triples 14 | (assert (eq? (* c c) (+ (* a a) (* b b)))) 15 | ; And only those with the second value less 16 | ; than the first. 17 | (assert (< b a)) 18 | (list a b c)))) 19 | 20 | ; Inspired by 21 | ; http://mitpress.mit.edu/sicp/full-text/sicp/book/node89.html 22 | ; amb has to be a macro to allow (possibly infinitely) expensive 23 | ; clauses to be amongst those included. Here, 'anything-starting-from' 24 | ; is an infinite combination. 25 | (amb-is-lazy 26 | 6 27 | (begin 28 | (define (anything-starting-from n) 29 | (amb n (anything-starting-from (+ n 1)))) 30 | (let a (anything-starting-from 3) 31 | (assert (eq? a 6)) 32 | a))) 33 | 34 | ; Here, we demonstrate that if you make 35 | ; multiple 'amb' operators then they do not 36 | ; interact with each other, which is desirable 37 | ; if only for performance. It's also desirable 38 | ; in that we usually only want small 39 | ; parts of the program to execute non-deterministically 40 | ; rather than the entire program. 41 | (multiple-amb 42 | "exhausted" 43 | (try 44 | (with* (exhausted (curry throw "exhausted") 45 | amb1 (make-amb-macro exhausted) 46 | assert1 (make-assert amb1) 47 | amb2 (make-amb-macro exhausted) 48 | assert2 (make-assert amb2)) 49 | (define a (amb1 1 2)) 50 | (define b (amb2 4 8)) 51 | (assert1 (eq? 9 (+ a b))) 52 | (list a b)) 53 | catch (msg c) 54 | msg)) 55 | 56 | 57 | (ambFunctionTest-Pythagorean (4 3 5) 58 | (begin 59 | (define amb (make-amb-function (curry throw "exhausted"))) 60 | (define assert (make-assert amb)) 61 | (with (a (amb '(1 2 3 4 5 6 7)) 62 | b (amb '(1 2 3 4 5 6 7)) 63 | c (amb '(1 2 3 4 5 6 7))) 64 | ; We only want pythagorean triples 65 | (assert (eq? (* c c) (+ (* a a) (* b b)))) 66 | ; And only those with the second value less 67 | ; than the first. 68 | (assert (< b a)) 69 | (list a b c)))) 70 | ) 71 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/ArithmeticTests.lisp: -------------------------------------------------------------------------------- 1 | ; Simple arithmetic tests 2 | (tests 3 | (add 5 4 | (+ 2 3)) 5 | (subtract 3 6 | (- 7 4)) 7 | (times 20 8 | (* 5 4)) 9 | (divide 5 10 | (/ 20 4)) 11 | 12 | ; bitwise functions. Used for bit sets. 13 | (bit-and 4 14 | (bit-and 4 7)) 15 | 16 | (bit-or 7 17 | (bit-or 4 7)) 18 | 19 | (bit-shift 14 20 | (bit-shift 7 1)) 21 | 22 | ; Test looping 23 | (length 24 | 3 25 | (length '(2 4 6)))) 26 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/CallCCTests.lisp: -------------------------------------------------------------------------------- 1 | ; Unit tests for call-cc 2 | (tests 3 | (simplestCallCC 5 4 | (call-cc (lambda (c) 5 | (+ 3 (c 5))))) 6 | (noopCallCC 5 7 | ((call-cc call-cc) (lambda (x) 5))) 8 | 9 | (backwardsCC 5 10 | ((call-cc (lambda (k) k)) (lambda (x) 5))) 11 | 12 | (letcc 23 13 | (let-cc c (+ 3 (c 23)))) 14 | 15 | (letcc-has-implicit-begin 16 | 6 17 | (begin 18 | (define x 5) 19 | (let-cc c 20 | (set! x 6) 21 | c x))) 22 | ) 23 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/DotNetTests.lisp: -------------------------------------------------------------------------------- 1 | (setup 2 | ; Bring in all static methods in the mscorlib assembly 3 | (define (invoke-instance method . args) 4 | (apply (make-instance-method method) args))) 5 | (tests 6 | ; Call the primitive invoke-method function 7 | (invoke-instance-simple 8 | "42" 9 | (invoke-instance "ToString" 42)) 10 | 11 | (invoke-instance-with-args1 12 | #t 13 | (invoke-instance "Equals" "hello world" "hello world")) 14 | (invoke-instance-with-args2 15 | #f 16 | (invoke-instance "Equals" "hello" "nothello")) 17 | 18 | (invoke-instance-macro 19 | "42" 20 | (.ToString 42)) 21 | ; Call a static method returning a value type (Boolean) 22 | (static-method 23 | #t 24 | (System.Convert/ToBoolean "true")) 25 | ; Call a static method returning void 26 | (static-method-void 27 | () 28 | (System.Console/WriteLine "hello")) 29 | ; Call an instance method (Equals) on a reference type (String) 30 | (instance-method-reftype 31 | #t 32 | (.Equals "hello" "hello")) 33 | ; Call an instance method (Equals) on a value type (Int32), passing a value type (Int32) 34 | (instance-method-valuetype 35 | #t 36 | (.Equals 1 1)) 37 | ; Call an instance method (Equals) on a value type (Int32), passing a reference type (String) 38 | (instance-method-valuetype-boxed-arg 39 | #f 40 | (.Equals 1 "hello")) 41 | 42 | ; Evaluation always has to be via the main stack rather than 43 | ; creating nested "Evaluator" instances. 44 | ; Otherwise, as evidenced below, the "exception" (one example 45 | ; of how we can use continuations), is only "thrown" to the 46 | ; .Net method call site rather than the original source 47 | ; of the continuation. 48 | (args-obey-continuations 49 | "failed" 50 | (let-cc error 51 | (.Equals "failed" (error "failed")))) 52 | 53 | (static-method-continuations 54 | "failed" 55 | (let-cc error 56 | (System.Console/WriteLine (error "failed")))) 57 | 58 | (static-method-is-function 59 | (#t #f) 60 | (map System.Convert/ToBoolean '("true" "false"))) 61 | 62 | (instance-method-as-function 63 | ("23" "34") 64 | (map (make-instance-method "ToString") '(23 34))) 65 | 66 | ; This expands into the above 67 | (instance-method-macro-as-function 68 | ("23" "34") 69 | (map .ToString '(23 34))) 70 | 71 | (multi-argument-higher-order 72 | (#t #f #t) 73 | (map .Equals '(1 "two" 3) '(1 2 3))) 74 | 75 | (invoke-constructor 76 | "This is an error" 77 | (.get_Message (new System.Exception "This is an error"))) 78 | 79 | (params 80 | "4 * 5 is 20" 81 | (System.String/Format "{0} * {1} is {2}" 4 5 (* 4 5))) 82 | 83 | ; We have a quandary: What to do if the input parameter 84 | ; is *not* an atom and it's passed as a parameter to a reflection 85 | ; function? Similarly, if a "reflection" function returns 86 | ; a Datum, should it be wrapped as an "atom" or not? 87 | 88 | ; For now, let's go with "smart" behaviour. 89 | ; If this doesn't do what's desired, we will also expose 90 | ; a "atom" function explicitly for wrapping a Datum so that 91 | ; it looks like an atom. 92 | (datum-types-static "(1 2 3)" (System.String/Format "{0}" '(1 2 3))) 93 | (datum-types-instance "(1 2 3)" (.ToString '(1 2 3))) 94 | 95 | ; If we want to treat an atom explicitly as an atom (no implicit unwrapping), 96 | ; wrap it using the 'atom' function (i.e. to turn off the 97 | ; builtin "unwrapping" of atoms that is the default). 98 | (atom-wrap 99 | "LispEngine.Datums.Atom" 100 | (.ToString (.GetType (atom 1)))) 101 | 102 | (get-type 103 | "System.Console" 104 | (.get_FullName (get-type "System" "Console"))) 105 | 106 | (get-type-macro 107 | "System.Console" 108 | (.get_FullName System.Console)) 109 | 110 | ; A macro reference to a non-existent type should throw 111 | ; an error 112 | (non-existent-type 113 | "ERROR" 114 | (try 115 | System.XXXX 116 | catch ex 117 | "ERROR")) 118 | 119 | ; Don't just look in calling assembly - look in all 120 | ; loaded assemblies in the current app domain. 121 | (uses-assembly-get-type 122 | "System.Diagnostics.Stopwatch" 123 | (.get_FullName System.Diagnostics.Stopwatch)) 124 | ) 125 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/EvalTests.lisp: -------------------------------------------------------------------------------- 1 | (tests 2 | ; "(env)" is an f-expression that returns the current environment. 3 | ; This environment is currently "opaque". 4 | ; "eval" is then a regular function that takes this environment 5 | ; and evaluates the expression. 6 | (simple-eval 7 | 15 8 | (eval '(* 3 5) (env))) 9 | (simple-read 10 | (* 5 3) 11 | (read (open-input-string "(* 5 3)"))) 12 | 13 | (eof-detect 14 | (#t #f) 15 | (map (compose eof-object? read open-input-string) 16 | '("" "(* 5 3)"))) 17 | 18 | ; The REPL would switch to "EOF" as soon as an unrecognized 19 | ; token was read, which is not very useful behaviour in 20 | ; a REPL. 21 | (unrecognized-token 22 | 5 23 | (let s (open-input-string "@5") 24 | (try 25 | (read s) 26 | catch msg 27 | (read s)))) 28 | 29 | ) 30 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/EvaluatorTests.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections.Generic; 3 | using System.Linq; 4 | using LispEngine.Bootstrap; 5 | using LispEngine.Datums; 6 | using LispEngine.Evaluation; 7 | using LispEngine.Util; 8 | using NUnit.Framework; 9 | 10 | namespace LispTests.Evaluation 11 | { 12 | [TestFixture("PatternMatchingTests.lisp")] 13 | [TestFixture("CallCCTests.lisp")] 14 | [TestFixture("QuasiquoteTests.lisp")] 15 | [TestFixture("EvaluatorTests.lisp")] 16 | [TestFixture("ArithmeticTests.lisp")] 17 | [TestFixture("MacroBuiltinTests.lisp")] 18 | [TestFixture("DotNetTests.lisp")] 19 | [TestFixture("EvalTests.lisp")] 20 | [TestFixture("LibraryTests.lisp")] 21 | [TestFixture("AmbTests.lisp")] 22 | [TestFixture("VectorTests.lisp")] 23 | [TestFixture("SudokuTests.lisp")] 24 | class EvaluatorTests : DatumHelpers 25 | { 26 | private readonly string lispResourceFile; 27 | private Evaluator e; 28 | private LexicalEnvironment env; 29 | 30 | public EvaluatorTests(string lispResourceFile) 31 | { 32 | this.lispResourceFile = lispResourceFile; 33 | } 34 | 35 | [TestFixtureSetUp] 36 | public void setupFixture() 37 | { 38 | e = new Evaluator(); 39 | env = StandardEnvironment.Create(); 40 | var setupDatum = getLispFromResource("setup"); 41 | if (setupDatum != nil) 42 | foreach(var f in setupDatum.Enumerate()) 43 | e.Evaluate(env, f); 44 | } 45 | 46 | [Test, TestCaseSource("TestCases")] 47 | public Datum evaluate(Datum expression) 48 | { 49 | try 50 | { 51 | var result = e.Evaluate(env, expression); 52 | Console.WriteLine("Expression: {0}", expression); 53 | Console.WriteLine("Result: {0}", result); 54 | return result; 55 | } 56 | catch (Exception ex) 57 | { 58 | Console.WriteLine("ex: {0}", ex); 59 | throw; 60 | } 61 | } 62 | 63 | private static Datum checkQuote(Datum d) 64 | { 65 | var p = d as Pair; 66 | if (p != null && p.First.Equals(quote)) 67 | return p.Second.ToArray()[0]; 68 | return null; 69 | } 70 | 71 | private static TestCaseData datumToTestCase(Datum d) 72 | { 73 | var ignore = false; 74 | var quoted = checkQuote(d); 75 | if(quoted != null) 76 | { 77 | d = quoted; 78 | ignore = true; 79 | } 80 | var combo = d.ToArray(); 81 | 82 | if (combo.Length < 3) 83 | throw new Exception(string.Format("'{0}' is not a valid test case", d)); 84 | var name = combo[0] as Symbol; 85 | if (name == null) 86 | throw new Exception(string.Format("'{0}' is not a valid test case", d)); 87 | 88 | var expected = combo[1]; 89 | var expression = combo[2]; 90 | var testCase = new TestCaseData(expression); 91 | testCase.Returns(expected); 92 | testCase.SetName(name.Identifier); 93 | if (ignore) 94 | testCase.Ignore("quoted"); 95 | return testCase; 96 | } 97 | 98 | // We have to do this "inefficiently" rather than picking out 99 | // tests and setup in one pass because otherwise the error reporting 100 | // in NUnit does not work properly. This is because NUnit *first* 101 | // does "new EvaluatorTests(file).TestCases 102 | // and only *then* does 103 | // "new EvaluatorTests(file).setupFixture()". So we have to read the resource file 104 | // twice. Main thing is that we can arrange for "setup" to only 105 | // be executed once, while still having it run inside setupFixture(), which 106 | // is required for better NUnit error reporting. Throwing exceptions from the 107 | // TestCases method doesn't give great results. 108 | private Datum getLispFromResource(string name) 109 | { 110 | foreach (var d in ResourceLoader.ReadDatums(string.Format("LispTests.Evaluation.{0}", lispResourceFile))) 111 | { 112 | var list = d as Pair; 113 | if (list == null) 114 | throw error("Expected a list instead of '{0}'", d); 115 | if (list.First.Equals(symbol(name))) 116 | return list.Second; 117 | } 118 | return nil; 119 | } 120 | 121 | public IEnumerable TestCases 122 | { 123 | get 124 | { 125 | var testsDatum = getLispFromResource("tests"); 126 | return testsDatum.Enumerate().Select(datumToTestCase).ToArray(); 127 | } 128 | } 129 | } 130 | } 131 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/LibraryTests.lisp: -------------------------------------------------------------------------------- 1 | ; Tests of library functions written in FCLisp itself. 2 | ; The implementations are defined in Builtins.lisp 3 | (tests 4 | (foldrSimplest 10 5 | (fold-right + 10 '())) 6 | (foldrTest 25 7 | (fold-right + 10 '(1 2 3 4 5))) 8 | 9 | (mapCarSimplest () 10 | (mapcar (lambda (x) (* x x)) '())) 11 | (mapCarTest (1 4 9) 12 | (mapcar (lambda (x) (* x x)) '(1 2 3))) 13 | 14 | (mapSquare (1 4 9) 15 | (map (lambda (x) (* x x)) '(1 2 3))) 16 | (mapTest (4 10 18) 17 | (map * '(1 2 3) '(4 5 6))) 18 | (mapThreeTest ((1 4 7) (2 5 8) (3 6 9)) 19 | (map list '(1 2 3) '(4 5 6) '(7 8 9))) 20 | 21 | ; We've adopted explicit currying... it might 22 | ; be nicer to have implicit currying. Need to 23 | ; think about the best way to implement though. 24 | (curry 5 25 | (let add1 (curry + 1) 26 | (add1 4))) 27 | 28 | (fold-right-folds-right 29 | (1 2 3) 30 | (fold-right cons '() '(1 2 3))) 31 | 32 | (compose2 33 | 5 34 | ((compose2 car cdr) '(1 5 12))) 35 | (composeN 36 | 12 37 | ((compose car cdr cdr) '(1 5 12))) 38 | 39 | (cadr 5 (cadr '(1 5 12))) 40 | (caddr 12 (caddr '(1 5 12))) 41 | (cdddr (17) (cdddr '(1 5 12 17))) 42 | 43 | (find (5 6 7) 44 | (find 5 '(1 2 3 4 5 6 7))) 45 | 46 | (find-non-existent () 47 | (find 3 '(1 2 4))) 48 | 49 | (find-first (1 2 3) 50 | (find 1 '(1 2 3))) 51 | 52 | (after (4 5) 53 | (after 3 '(1 2 3 4 5))) 54 | 55 | (before (1 2) 56 | (before 3 '(1 2 3 4 5))) 57 | 58 | (try-catch-fail 59 | "Undefined symbol \'undefined\'" 60 | (try 61 | undefined 62 | undefined-not-reach 63 | catch ex (car ex))) 64 | 65 | (try-catch-success 66 | "SUCCESS" 67 | (try 68 | "SUCCESS" 69 | catch ex 70 | (car ex))) 71 | 72 | ; We allow multiple statements after the catch 73 | (catch-has-implicit-begin 74 | "Undefined symbol \'undefined\'" 75 | (try 76 | undefined 77 | catch ex 78 | (log (* 3 5)) 79 | (car ex))) 80 | 81 | ; We'll use 'throw' as the builtin 82 | ; for raising errors 83 | (throw 84 | "This is an error message" 85 | (try 86 | (throw "This is an error message") 87 | catch (msg c) 88 | msg)) 89 | 90 | (thunk-simplest 91 | 5 92 | (force (make-thunk 5))) 93 | 94 | (thunk-does-not-evaluate 95 | 5 96 | (begin 97 | (make-thunk undefined) 98 | 5)) 99 | 100 | (make-thunk-has-implicit-begin 101 | 6 102 | (force 103 | (make-thunk 5 6))) 104 | 105 | (loop-has-implicit-begin 106 | (1 2 3) 107 | (loop x '(1 2 3) 108 | 5 109 | x)) 110 | 111 | (loop-evaluates-left-to-right 112 | (3 2 1) 113 | (begin 114 | (define x nil) 115 | (loop y '(1 2 3) 116 | (set! x (cons y x))) 117 | x)) 118 | 119 | (cartesian-map1 120 | ((1 4) (1 8) (2 4) (2 8)) 121 | (cartesian-map list '(1 2) '(4 8))) 122 | 123 | (cartesian-map2 124 | ((a c f) (a c g) (a d f) (a d g) (a e f) (a e g) 125 | (b c f) (b c g) (b d f) (b d g) (b e f) (b e g)) 126 | (cartesian-map list '(a b) '(c d e) '(f g))) 127 | 128 | (filter-test 129 | (2 4) 130 | (filter 131 | (lambda (2) #t 132 | (4) #t 133 | _ #f) 134 | '(1 2 3 4 5 6))) 135 | 136 | (in-test 137 | (#t #f) 138 | (loop x '(3 5) 139 | (in x '(2 3 6 7)))) 140 | 141 | (remove-test 142 | ( (1 2 3 4 5 6 7) (2 3 4 5 6 7) (1 2 4 5 6 7) (1 2 3 4 5 6) ) 143 | (let elements '(1 2 3 4 5 6 7) 144 | (loop x '(8 1 3 7) 145 | (remove x elements)))) 146 | 147 | (remove-one-test 148 | (1 3 6) 149 | (sort (remove-one 6 '(1 6 3 6)))) 150 | 151 | (replace-test 152 | (1 2 20 4 5) 153 | (replace 3 20 '(1 2 3 4 5))) 154 | 155 | (assoc-test 156 | ( ((a . 1) 1 2 3) 157 | ((a . 2) 4 5 6) 158 | #f) 159 | 160 | (begin 161 | (define a1 '(a . 1)) 162 | (define a2 '(a . 2)) 163 | (define a3 '(a . 3)) 164 | (define pairs `((,a1 . (1 2 3)) (,a2 . (4 5 6)))) 165 | (loop key (list a1 a2 a3) 166 | (assoc key pairs)))) 167 | 168 | (assoc-test-simplest 169 | #f 170 | (assoc 4 '())) 171 | 172 | 173 | (dict-test 174 | ((5 4 6) (1 2 3)) 175 | (begin 176 | (define a1 '(A . 1)) 177 | (define a2 '(A . 2)) 178 | (define d (make-dict `((,a1 . (5 4 6)) 179 | (,a2 . (1 2 3))))) 180 | (list 181 | (lookup d a1) 182 | (lookup d a2)))) 183 | 184 | (dict-update 185 | ((5 4 6) (7 8 9)) 186 | (begin 187 | (define a1 '(A . 1)) 188 | (define a2 '(A . 2)) 189 | (define d (make-dict `((,a1 . (5 4 6)) 190 | (,a2 . (1 2 3))))) 191 | (define d2 (dict-update d a2 '(7 8 9))) 192 | (map cdr d2))) 193 | 194 | (test-sort 195 | (3 5 8) 196 | (sort '(5 3 8))) 197 | 198 | (test-sort-bigger 199 | (3 4 5 6 7 8) 200 | (sort '(7 5 4 3 6 8))) 201 | 202 | ; 'set' is using fold-right so 203 | ; precedence is determined right to left. 204 | (test-unique 205 | (4 3 1 2 5 8) 206 | (unique '(4 3 3 1 5 8 8 2 5 5 8))) 207 | 208 | ; Convenient function for generating a list 209 | ; off of an index 210 | (test-repeat 211 | (() (0 1 2 3 4) (0) (0 1 2)) 212 | (mapcar (curry repeat identity) '(0 5 1 3))) 213 | 214 | (test-max 215 | 6 216 | (max '(4 6 2 1))) 217 | 218 | (test-search 219 | (1 2) 220 | (search (lambda ((a b)) (eq? a 1)) 221 | '((2 3) (1 2) (4 5)))) 222 | 223 | (test-filter-loop 224 | (2 4 6) 225 | (filter-loop x '(1 2 3 4 5 6 7 8) (in x '(2 4 6)))) 226 | 227 | (test-fold-loop 228 | (3 4 5 6) 229 | (fold-loop x '(3 4 5 6) l nil 230 | (cons x l))) 231 | 232 | (test-or-simple 233 | 5 234 | (or 5 undefined)) 235 | 236 | (test-or-only-evaluates-once 237 | 2 238 | (begin 239 | (define x 1) 240 | (or (set! x (+ x 1)) undefined))) 241 | 242 | (test-or-multiple 243 | 3 244 | (or #f #f 3 4)) 245 | 246 | (test-and-simple 247 | 6 248 | (and 5 6)) 249 | 250 | (test-and-single 251 | 5 252 | (and 5)) 253 | 254 | (test-and-short-circuit 255 | #f 256 | (and #f undefined)) 257 | 258 | (test-and-only-evaluates-once 259 | (2 3) 260 | (begin 261 | (define x 1) 262 | (define y (and (set! x (+ x 1)) 263 | 3)) 264 | (list x y))) 265 | ) 266 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/MacroBuiltinTests.lisp: -------------------------------------------------------------------------------- 1 | (tests 2 | (define-macro 8 3 | (begin 4 | ; Just duplicate the original 'let' macro 5 | (define-macro slet (var value body) 6 | `((,lambda (,var) ,body) ,value)) 7 | (slet x 5 (+ x 3)))) 8 | 9 | ; Expand gives useful way to debug macro expansions 10 | (expand 11 | ((lambda-symbol (x) (+ x 3)) 5) 12 | (begin 13 | ; So that the unit test can 'work' 14 | (define lambda 'lambda-symbol) 15 | (define-macro slet (var value body) 16 | `((,lambda (,var) ,body) ,value)) 17 | (expand (env) '(slet x 5 (+ x 3))))) 18 | 19 | ; For a non-macro, we'll have expand just 20 | ; return the original expression 21 | (expand-non-macro 22 | (square 3) 23 | (begin 24 | (define (square x) 25 | (* x x)) 26 | (expand (env) '(square 3)))) 27 | 28 | ; We ought to support the traditional scheme 29 | ; "define function" syntax 30 | (define-function 25 31 | (begin 32 | (define (square x) (* x x)) 33 | (square 5))) 34 | 35 | (define-function-two-args 18 36 | (begin 37 | (define (subtract x y) (- x y)) 38 | (subtract 21 3))) 39 | 40 | (define-function-multiple-sub-expressions 10 41 | (begin 42 | (define (subtract x y) 43 | 35 ; this is evaluated but ignored 44 | (- x y)) 45 | (subtract 15 5))) 46 | 47 | ; Our own homegrown 'list comprehension' syntax 48 | ; which is implemented in terms of map 49 | (loop (1 4 9 16) 50 | (loop x '(1 2 3 4) 51 | (* x x))) 52 | 53 | ; 'with' is like let but allows multiple variable 54 | ; definitions. 55 | (with (5 100 7) 56 | (with (x 5 y 100 z 7) 57 | (list x y z))) 58 | 59 | (let-cc 23 60 | (let-cc return 61 | (+ 5 (return 23)))) 62 | 63 | (match 3 64 | (with (x 4 y 5) 65 | (match `(,x ,y) 66 | (1 2) 0 67 | (2 3) 1 68 | (3 4) 2 69 | (4 z) (- z 2) 70 | (5 6) 4))) 71 | 72 | ; Test macro expansion caching 73 | ; This example is somewhat contrived - I'd like to know 74 | ; of a more natural case. 75 | 76 | ; But the basic idea is: whenever our "code" tree has a graph 77 | ; then there's the potential for the macro expansion 78 | ; cache to fail, because we cache the macro expansion 79 | ; inside each Datum instance. 80 | 81 | ; Here, we've created a macro which creates a graph, 82 | ; in which different first-class macros are applied to 83 | ; the same Datum. 84 | ; So the following _should_ expand in the equivalent of 85 | ; (list (and #f #t) (or #f #t)) 86 | ; but because (#f #t) is the same Datum *instance*, 87 | ; the 'and' expansion gets cached and used for both 88 | ; cases. 89 | 90 | ; The solution is for the macro to use itself as part 91 | ; of the "key" for the cache. But because this is a 92 | ; a contrived case we simply have a "check" in the datum. 93 | (macro-cache-in-datum 94 | (#f #t) 95 | (begin 96 | (define-macro fapply (f1 f2 arg-list) 97 | (list list 98 | (cons f1 arg-list) 99 | (cons f2 arg-list))) 100 | (fapply and or (#f #t)))) 101 | ) 102 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/PatternMatchingTests.lisp: -------------------------------------------------------------------------------- 1 | ; Our lambda f-expression does full "pattern" matching 2 | ; on all of its arguments. If you already have to implement 3 | ; the standard cases (lambda x lambda (x . y) lambda (x y . z)) 4 | ; then implementing full recursive pattern matching is not 5 | ; really any more difficult, and makes for substantially 6 | ; simpler code everywhere else. 7 | (tests 8 | (patternMatch1 6 9 | ((lambda (a (b c)) c) 4 (list 5 6))) 10 | (patternMatch2 6 11 | ((lambda ((a b) c) b) (list 5 6) 4)) 12 | (patternMatch3 5 13 | ((lambda (((a))) a) (list (list 5)))) 14 | (caseLambdaPair #t 15 | ((lambda ((x . y)) #t x #f) (list 3 4))) 16 | (caseLambdaPairWithAtom #f 17 | ((lambda ((x . y)) #t x #f) 3)) 18 | (carUsingPatternMatch 3 19 | ((lambda ((x . y)) x) '(3 . 4))) 20 | (cdrUsingPatternMatch 4 21 | ((lambda ((x . y)) y) '(3 . 4))) 22 | (lambdaAtomArgs 2 23 | ((lambda (1) 2) 1)) 24 | (pairBindingChecksForNull #t 25 | ((lambda ((#f . x)) life ((y . x)) y) '(#t 3))) 26 | ; We extend the 'quote syntax for lambda binding 27 | ; to allow us to pattern match against symbols as well 28 | ; as atoms 29 | (lambdaSymbolBind 26 30 | ((lambda ('some-symbol x) x) 31 | 'some-symbol 26)) 32 | (lambdaSymbolCase 3 33 | ((lambda ('add1 x) (+ 1 x) 34 | ('subtract1 x) (- x 1)) 35 | 'subtract1 4))) 36 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/QuasiquoteTests.lisp: -------------------------------------------------------------------------------- 1 | ; Quasiquote test cases 2 | (setup 3 | (define life 42)) 4 | (tests 5 | (quasiquoteAtom 1 `1) 6 | (quasiquoteSymbol x `x) 7 | (quasiquoteList (1 2) `(1 2)) 8 | (quasiquoteUnquote 42 `,life) 9 | (quasiquoteUnquoteUsingLet 6 10 | (let x 6 `,x)) 11 | (quasiquoteUnquoteList (1 6) 12 | (let x 6 13 | `(1 ,x))) 14 | (quasiquoteQuoted (list a 'a) 15 | (let name 'a 16 | `(list ,name ',name))) 17 | (quasiquoteSplicingSimplest 18 | (1 2) 19 | `(,@(list 1 2))) 20 | (quasiquoteSplicing 21 | (1 2 3 4 5) 22 | `(1 ,@(list 2 3) 4 5)) 23 | (mapQuasiQuoteTest (1 2 3 1 4 9 4 5 6) 24 | `(1 2 3 ,@(map (lambda (x) (* x x)) '(1 2 3)) 4 5 6))) 25 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/SudokuTests.lisp: -------------------------------------------------------------------------------- 1 | (setup 2 | (run "..\\..\\..\\Lisp\\Examples\\Sudoku.lisp" (env)) 3 | ) 4 | (tests 5 | (show-digits 6 | (1 2 3 4 5 6 7 8 9) 7 | (show-digits all-digits)) 8 | 9 | (remove-digit 10 | (1 3 4) 11 | (show-digits (remove-digit (digit-set 1 2 3 4) 2))) 12 | 13 | (remove-digit-already-gone 14 | (1 2 3 4) 15 | (show-digits (remove-digit (digit-set 1 2 3 4) 5))) 16 | 17 | (add-digit 18 | (1 3 4) 19 | (show-digits (add-digit (digit-set 1 4) 3))) 20 | 21 | (solved-digit? 22 | (#f 6) 23 | (mapcar solved-digit? (list (digit-set 2 4) (digit-set 6)))) 24 | 25 | (grid-get-set 26 | 23 27 | (begin 28 | (define g (new-grid)) 29 | (set-square! g 45 23) 30 | (get-square g 45))) 31 | 32 | (solved-true? 33 | #t 34 | (solved? parsed1)) 35 | 36 | (solved-false? 37 | #f 38 | (solved? parsed2)) 39 | 40 | ; We can solve grid1 using only technique 1: 41 | ; eliminate peers. 42 | (parse-grid 43 | (((4) (8) (3) (9) (2) (1) (6) (5) (7)) 44 | ((9) (6) (7) (3) (4) (5) (8) (2) (1)) 45 | ((2) (5) (1) (8) (7) (6) (4) (9) (3)) 46 | ((5) (4) (8) (1) (3) (2) (9) (7) (6)) 47 | ((7) (2) (9) (5) (6) (4) (1) (3) (8)) 48 | ((1) (3) (6) (7) (9) (8) (2) (4) (5)) 49 | ((3) (7) (2) (6) (8) (9) (5) (1) (4)) 50 | ((8) (1) (4) (2) (5) (3) (7) (6) (9)) 51 | ((6) (9) (5) (4) (1) (7) (3) (8) (2))) 52 | (grid->lists parsed1)) 53 | 54 | ; Grid2 requires search 55 | (solve-grid2 56 | (((4) (1) (7) (3) (6) (9) (8) (2) (5)) 57 | ((6) (3) (2) (1) (5) (8) (9) (4) (7)) 58 | ((9) (5) (8) (7) (2) (4) (3) (1) (6)) 59 | ((8) (2) (5) (4) (3) (7) (1) (6) (9)) 60 | ((7) (9) (1) (5) (8) (6) (4) (3) (2)) 61 | ((3) (4) (6) (9) (1) (2) (7) (5) (8)) 62 | ((2) (8) (9) (6) (4) (3) (5) (7) (1)) 63 | ((5) (7) (3) (2) (9) (1) (6) (8) (4)) 64 | ((1) (6) (4) (8) (7) (5) (2) (9) (3))) 65 | (grid->lists solution2)) 66 | ) 67 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/VectorTests.lisp: -------------------------------------------------------------------------------- 1 | (tests 2 | (make-vector 3 | #(0 0 0) 4 | (make-vector 3)) 5 | 6 | (make-vector 7 | #("X" "X" "X") 8 | (make-vector 3 "X")) 9 | 10 | (vector-length 11 | 3 12 | (vector-length '#(0 0 0))) 13 | 14 | ; Hmm: could we do pattern 15 | ; matching for vector? 16 | (vector? 17 | (#t #f) 18 | (mapcar vector? '(#(0) 5))) 19 | 20 | (vector 21 | #(1 2 3) 22 | (vector 1 2 3)) 23 | 24 | (vector-ref 25 | 2 26 | (vector-ref #(1 2 3) 1)) 27 | 28 | (vector-set! 29 | #(1 4 3) 30 | (begin 31 | (define x #(1 2 3)) 32 | (vector-set! x 1 4) 33 | x)) 34 | 35 | (vector-copy 36 | #(1 2 3) 37 | (begin 38 | (define x #(1 2 3)) 39 | (define y (vector-copy x)) 40 | (vector-set! x 1 3) 41 | y)) 42 | ) 43 | -------------------------------------------------------------------------------- /Lisp/LispTests/Evaluation/�: -------------------------------------------------------------------------------- 1 | ; Tests of library functions written in FCLisp itself. 2 | ; The implementations are defined in Builtins.lisp 3 | (tests 4 | (foldrSimplest 10 5 | (fold-right + 10 '())) 6 | (foldrTest 25 7 | (fold-right + 10 '(1 2 3 4 5))) 8 | 9 | (mapCarSimplest () 10 | (mapcar (lambda (x) (* x x)) '())) 11 | (mapCarTest (1 4 9) 12 | (mapcar (lambda (x) (* x x)) '(1 2 3))) 13 | 14 | (mapSquare (1 4 9) 15 | (map (lambda (x) (* x x)) '(1 2 3))) 16 | (mapTest (4 10 18) 17 | (map * '(1 2 3) '(4 5 6))) 18 | (mapThreeTest ((1 4 7) (2 5 8) (3 6 9)) 19 | (map list '(1 2 3) '(4 5 6) '(7 8 9))) 20 | 21 | ; We've adopted explicit currying... it might 22 | ; be nicer to have implicit currying. Need to 23 | ; think about the best way to implement though. 24 | (curry 5 25 | (let add1 (curry + 1) 26 | (add1 4))) 27 | 28 | (fold-right-folds-right 29 | (1 2 3) 30 | (fold-right cons '() '(1 2 3))) 31 | 32 | (compose2 33 | 5 34 | ((compose2 car cdr) '(1 5 12))) 35 | (composeN 36 | 12 37 | ((compose car cdr cdr) '(1 5 12))) 38 | 39 | (cadr 5 (cadr '(1 5 12))) 40 | (caddr 12 (caddr '(1 5 12))) 41 | (cdddr (17) (cdddr '(1 5 12 17))) 42 | 43 | (find (5 6 7) 44 | (find 5 '(1 2 3 4 5 6 7))) 45 | 46 | (find-non-existent () 47 | (find 3 '(1 2 4))) 48 | 49 | (find-first (1 2 3) 50 | (find 1 '(1 2 3))) 51 | 52 | (after (4 5) 53 | (after 3 '(1 2 3 4 5))) 54 | 55 | (before (1 2) 56 | (before 3 '(1 2 3 4 5))) 57 | 58 | (define msg car) 59 | 60 | (try-catch-fail 61 | "Undefined symbol \'undefined\'" 62 | (try 63 | undefined 64 | undefined-not-reach 65 | catch ex (msg ex))) 66 | 67 | (try-catch-success 68 | "SUCCESS" 69 | (try 70 | "SUCCESS" 71 | catch ex 72 | (msg ex))) 73 | 74 | ; We allow multiple statements after the catch 75 | (catch-has-implicit-begin 76 | "Undefined symbol \'undefined\'" 77 | (try 78 | undefined 79 | catch ex 80 | (log (* 3 5)) 81 | (msg ex))) 82 | 83 | ) 84 | -------------------------------------------------------------------------------- /Lisp/LispTests/LispTests.csproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Debug 5 | AnyCPU 6 | 8.0.30703 7 | 2.0 8 | {2517BF60-4567-456F-AE2E-25B280AD24F2} 9 | Library 10 | Properties 11 | LispTests 12 | LispTests 13 | v4.0 14 | 512 15 | 16 | 17 | true 18 | full 19 | false 20 | bin\Debug\ 21 | DEBUG;TRACE 22 | prompt 23 | 4 24 | 25 | 26 | pdbonly 27 | true 28 | bin\Release\ 29 | TRACE 30 | prompt 31 | 4 32 | 33 | 34 | 35 | ..\Packages\NUnit\lib\nunit.framework.dll 36 | True 37 | 38 | 39 | 40 | 41 | 42 | 43 | 44 | 45 | 46 | 47 | 48 | 49 | 50 | 51 | 52 | 53 | 54 | 55 | {81EE52DF-F912-4FE5-973C-262762CA3B99} 56 | LispEngine 57 | 58 | 59 | 60 | 61 | PreserveNewest 62 | 63 | 64 | 65 | 66 | 67 | 68 | 69 | 70 | 71 | 72 | 73 | 74 | 75 | 76 | 77 | 78 | 79 | 80 | 81 | 82 | 83 | 84 | 85 | 86 | 87 | 88 | 89 | 90 | 91 | 92 | 93 | 94 | 95 | 96 | 97 | 98 | 99 | 100 | 101 | 108 | -------------------------------------------------------------------------------- /Lisp/LispTests/Parsing/Lexing/ScannerTest.cs: -------------------------------------------------------------------------------- 1 | using System; 2 | using System.Collections; 3 | using System.Collections.Generic; 4 | using System.IO; 5 | using LispEngine.Datums; 6 | using LispEngine.Lexing; 7 | using NUnit.Framework; 8 | 9 | namespace LispTests.Lexing 10 | { 11 | [TestFixture] 12 | public class ScannerTest 13 | { 14 | private static Token token(TokenType type, string contents) 15 | { 16 | return new Token(type, contents); 17 | } 18 | 19 | private static Token symbol(string s) 20 | { 21 | return token(TokenType.Symbol, s); 22 | } 23 | 24 | private static Token space(string s) 25 | { 26 | return token(TokenType.Space, s); 27 | } 28 | 29 | private static readonly Token open = token(TokenType.Open, "("); 30 | private static readonly Token close = token(TokenType.Close, ")"); 31 | private static readonly Token sp = space(" "); 32 | 33 | private static Token integer(string s) 34 | { 35 | return token(TokenType.Integer, s); 36 | } 37 | 38 | private static Token number(string s) 39 | { 40 | return token(TokenType.Double, s); 41 | } 42 | 43 | private static Token str(string s) 44 | { 45 | return token(TokenType.String, s); 46 | } 47 | 48 | private static void test(string text, params Token[] expected) 49 | { 50 | var c = 0; 51 | var s = Scanner.Create(text); 52 | foreach (var t in s.Scan()) 53 | { 54 | Console.WriteLine("Token: {0}", t); 55 | Assert.AreEqual(expected[c], t); 56 | ++c; 57 | } 58 | Assert.AreEqual(expected.Length, c); 59 | } 60 | 61 | [Test] 62 | public void testRecoveryAfterUnrecognizedToken() 63 | { 64 | var s = Scanner.Create("@5"); 65 | var tokens1 = s.Scan().GetEnumerator(); 66 | Token t2 = null; 67 | try 68 | { 69 | tokens1.MoveNext(); 70 | } 71 | catch(Exception) 72 | { 73 | var tokens2 = s.Recover().GetEnumerator(); 74 | tokens2.MoveNext(); 75 | t2 = tokens2.Current; 76 | } 77 | Assert.AreEqual(new Token(TokenType.Integer, "5"), t2); 78 | } 79 | 80 | [Test] 81 | public void TestSpace() 82 | { 83 | test(" ", sp); 84 | } 85 | 86 | [Test] 87 | public void Test2Spaces() 88 | { 89 | test(" ", space(" ")); 90 | } 91 | 92 | [Test] 93 | public void TestSymbol() 94 | { 95 | test("one", symbol("one")); 96 | } 97 | 98 | [Test] 99 | public void TestHelloWorld() 100 | { 101 | test("hello world", symbol("hello"), sp, symbol("world")); 102 | } 103 | 104 | [Test] 105 | public void testInteger() 106 | { 107 | test("55", token(TokenType.Integer, "55")); 108 | } 109 | 110 | [Test] 111 | public void testNegativeInteger() 112 | { 113 | test("-55", integer("-55")); 114 | } 115 | 116 | [Test] 117 | public void testFloat() 118 | { 119 | numberTest("4.5"); 120 | } 121 | 122 | [Test] 123 | public void testPositiveInteger() 124 | { 125 | test("+55", integer("+55")); 126 | } 127 | 128 | [Test] 129 | public void testImplicitZero() 130 | { 131 | numberTest(".5"); 132 | } 133 | 134 | [Test] 135 | public void testImplicitPositiveZero() 136 | { 137 | numberTest("+.5"); 138 | } 139 | 140 | [Test] 141 | public void testImplicitNegativeZero() 142 | { 143 | numberTest("-.5"); 144 | } 145 | 146 | private static void numberTest(string s) 147 | { 148 | test(s, number(s)); 149 | } 150 | 151 | [Test] 152 | public void testScientific() 153 | { 154 | numberTest("1.e+10"); 155 | numberTest("1e10"); 156 | numberTest("+1e10"); 157 | numberTest("+15e10"); 158 | numberTest("-1e10"); 159 | numberTest("1.e10"); 160 | numberTest("1.3e2"); 161 | numberTest("1e-2"); 162 | numberTest("1e+2"); 163 | } 164 | 165 | [Test] 166 | public void testInvalidExponent() 167 | { 168 | test(".e ", symbol(".e"), sp); 169 | } 170 | 171 | 172 | [Test] 173 | public void testInvalidExponent2() 174 | { 175 | test(".every ", symbol(".every"), sp); 176 | } 177 | 178 | [Test] 179 | public void testMixedSymbolInteger() 180 | { 181 | test("Hello 22 World", symbol("Hello"), sp, integer("22"), sp, symbol("World")); 182 | } 183 | 184 | [Test] 185 | public void testOpenClose() 186 | { 187 | test("(printf)", open, symbol("printf"), close); 188 | } 189 | 190 | [Test] 191 | public void TestDot() 192 | { 193 | test("5 . 6", integer("5"), sp, token(TokenType.Dot, "."), sp, integer("6")); 194 | } 195 | 196 | [Test] 197 | public void TestSymbolQuestionMark() 198 | { 199 | test("eq?", symbol("eq?")); 200 | } 201 | 202 | [Test] 203 | public void TestSymbolSpecial() 204 | { 205 | test("e-+.@", symbol("e-+.@")); 206 | } 207 | 208 | private static Token boolean(string c) 209 | { 210 | return token(TokenType.Boolean, c); 211 | } 212 | 213 | [Test] 214 | public void testBoolean() 215 | { 216 | test("#t #T", boolean("#t"), sp, boolean("#T")); 217 | test("#f #F", boolean("#f"), sp, boolean("#F")); 218 | } 219 | 220 | private static readonly Token quote = token(TokenType.Quote, DatumHelpers.quoteAbbreviation); 221 | private static readonly Token quasiquote = token(TokenType.Quote, DatumHelpers.quasiquoteAbbreviation); 222 | private static readonly Token unquote = token(TokenType.Quote, DatumHelpers.unquoteAbbreviation); 223 | private static readonly Token splicing = token(TokenType.Quote, DatumHelpers.splicingAbbreviation); 224 | 225 | [Test] 226 | public void testQuote() 227 | { 228 | test("'(3 4)", quote, open, integer("3"), sp, integer("4"), close); 229 | } 230 | 231 | [Test] 232 | public void testQuasiQuote() 233 | { 234 | test("`(,3 ,@(4 5))", quasiquote, open, unquote, integer("3"), sp, splicing, open, integer("4"), sp, integer("5"), close, close); 235 | } 236 | 237 | [Test] 238 | public void testStringLiteral() 239 | { 240 | test("\"Hello world\"", str("\"Hello world\"")); 241 | } 242 | 243 | private static readonly Token vectorOpen = token(TokenType.VectorOpen, "#("); 244 | [Test] 245 | public void testVectorLiteral() 246 | { 247 | test("#(1)", vectorOpen, integer("1"), close); 248 | } 249 | } 250 | } 251 | -------------------------------------------------------------------------------- /Lisp/LispTests/Parsing/MultilineFile.lisp: -------------------------------------------------------------------------------- 1 | (- (+ 7 2 | (* 3 6)) 3 | ; This is a comment 4 | 3 5 | ) 6 | -------------------------------------------------------------------------------- /Lisp/LispTests/Parsing/MultilineFile.lisp~: -------------------------------------------------------------------------------- 1 | (- (+ 7 2 | (* 3 6)) 3 | ; This is a comment 4 | 3 5 | )) 6 | -------------------------------------------------------------------------------- /Lisp/LispTests/Properties/AssemblyInfo.cs: -------------------------------------------------------------------------------- 1 | using System.Reflection; 2 | using System.Runtime.CompilerServices; 3 | using System.Runtime.InteropServices; 4 | 5 | // General Information about an assembly is controlled through the following 6 | // set of attributes. Change these attribute values to modify the information 7 | // associated with an assembly. 8 | [assembly: AssemblyTitle("LispTests")] 9 | [assembly: AssemblyDescription("")] 10 | [assembly: AssemblyConfiguration("")] 11 | [assembly: AssemblyCompany("")] 12 | [assembly: AssemblyProduct("LispTests")] 13 | [assembly: AssemblyCopyright("Copyright © 2012")] 14 | [assembly: AssemblyTrademark("")] 15 | [assembly: AssemblyCulture("")] 16 | 17 | // Setting ComVisible to false makes the types in this assembly not visible 18 | // to COM components. If you need to access a type in this assembly from 19 | // COM, set the ComVisible attribute to true on that type. 20 | [assembly: ComVisible(false)] 21 | 22 | // The following GUID is for the ID of the typelib if this project is exposed to COM 23 | [assembly: Guid("1508e7e7-5bd4-4553-990c-c59d064f0580")] 24 | 25 | // Version information for an assembly consists of the following four values: 26 | // 27 | // Major Version 28 | // Minor Version 29 | // Build Number 30 | // Revision 31 | // 32 | // You can specify all the values or you can default the Build and Revision Numbers 33 | // by using the '*' as shown below: 34 | // [assembly: AssemblyVersion("1.0.*")] 35 | [assembly: AssemblyVersion("1.0.0.0")] 36 | [assembly: AssemblyFileVersion("1.0.0.0")] 37 | -------------------------------------------------------------------------------- /Lisp/Packages/NUnit/NUnit.nupkg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Patient0/FirstClassLisp/261c7ed81cc75f399c4989814717ee474291b641/Lisp/Packages/NUnit/NUnit.nupkg -------------------------------------------------------------------------------- /Lisp/Packages/NUnit/lib/nunit.framework.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Patient0/FirstClassLisp/261c7ed81cc75f399c4989814717ee474291b641/Lisp/Packages/NUnit/lib/nunit.framework.dll -------------------------------------------------------------------------------- /Lisp/Packages/NUnit/license.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Patient0/FirstClassLisp/261c7ed81cc75f399c4989814717ee474291b641/Lisp/Packages/NUnit/license.txt --------------------------------------------------------------------------------