├── .gitignore ├── LICENSE.txt ├── README.md ├── TODO.txt ├── benchmarks ├── fib.sl └── python │ ├── .gitignore │ ├── benchmark.py │ └── fib.py ├── examples ├── aoc23 │ ├── README.md │ ├── code1-1.sl │ ├── code2-1.sl │ ├── input1 │ └── input2 ├── fire │ ├── README.md │ ├── fire.sl │ └── screenshot.png └── remote-repl │ ├── README.md │ ├── client │ └── server ├── fib.sl ├── sharpl.csproj ├── sharpl.sln ├── src ├── Imports.cs ├── Program.cs └── Sharpl │ ├── Call.cs │ ├── Duration.cs │ ├── Env.cs │ ├── Error.cs │ ├── Fix.cs │ ├── Form.cs │ ├── Forms │ ├── And.cs │ ├── Array.cs │ ├── Binding.cs │ ├── Call.cs │ ├── Id.cs │ ├── Literal.cs │ ├── Map.cs │ ├── Nil.cs │ ├── Pair.cs │ ├── Quote.cs │ ├── Splat.cs │ └── Unquote.cs │ ├── Iter.cs │ ├── Iters │ ├── Core │ │ ├── CharRange.cs │ │ ├── EnumeratorItems.cs │ │ ├── FixRange.cs │ │ ├── IntRange.cs │ │ ├── Nil.cs │ │ ├── PairItems.cs │ │ ├── PipeItems.cs │ │ ├── PortItems.cs │ │ └── Zip.cs │ ├── FilterItems.cs │ ├── IO │ │ └── StreamLines.cs │ ├── MapItems.cs │ ├── Net │ │ └── ServerConnections.cs │ └── Time │ │ └── TimeRange.cs │ ├── Json.cs │ ├── Label.cs │ ├── Lib.cs │ ├── Libs │ ├── Char.cs │ ├── Core.cs │ ├── Fix.cs │ ├── IO.cs │ ├── Iter.cs │ ├── Json.cs │ ├── Net.cs │ ├── String.cs │ ├── Term.cs │ └── Time.cs │ ├── List.cs │ ├── Loc.cs │ ├── Macro.cs │ ├── Method.cs │ ├── Net │ └── StreamPort.cs │ ├── Op.cs │ ├── Ops │ ├── And.cs │ ├── BeginFrame.cs │ ├── Benchmark.cs │ ├── Branch.cs │ ├── CallDirect.cs │ ├── CallMethod.cs │ ├── CallRegister.cs │ ├── CallStack.cs │ ├── CallTail.cs │ ├── CallUserMethod.cs │ ├── Check.cs │ ├── CopyRegister.cs │ ├── CreateArray.cs │ ├── CreateIter.cs │ ├── CreateList.cs │ ├── CreateMap.cs │ ├── CreatePair.cs │ ├── Decrement.cs │ ├── Drop.cs │ ├── EndFrame.cs │ ├── ExitMethod.cs │ ├── GetRegister.cs │ ├── Goto.cs │ ├── Increment.cs │ ├── IterNext.cs │ ├── OpenInputStream.cs │ ├── Or.cs │ ├── PopItem.cs │ ├── PrepareClosure.cs │ ├── Push.cs │ ├── PushItem.cs │ ├── PushSplat.cs │ ├── Repush.cs │ ├── SetArrayItem.cs │ ├── SetLoadPath.cs │ ├── SetMapItem.cs │ ├── SetRegister.cs │ ├── Splat.cs │ ├── Stop.cs │ ├── Swap.cs │ ├── Try.cs │ ├── UnquoteRegister.cs │ └── Unzip.cs │ ├── Order.cs │ ├── OrderedMap.cs │ ├── PipePort.cs │ ├── Port.cs │ ├── REPL.cs │ ├── Reader.cs │ ├── Readers │ ├── And.cs │ ├── Array.cs │ ├── Call.cs │ ├── Char.cs │ ├── Fix.cs │ ├── Id.cs │ ├── Int.cs │ ├── Length.cs │ ├── Map.cs │ ├── OneOf.cs │ ├── Pair.cs │ ├── Quote.cs │ ├── Range.cs │ ├── Splat.cs │ ├── String.cs │ ├── Unquote.cs │ └── WhiteSpace.cs │ ├── Register.cs │ ├── StackExtensions.cs │ ├── Sym.cs │ ├── TaskUtil.cs │ ├── Term.cs │ ├── TimeUtil.cs │ ├── Type.cs │ ├── Types │ ├── Core │ │ ├── Array.cs │ │ ├── Binding.cs │ │ ├── Bit.cs │ │ ├── Char.cs │ │ ├── CloseTrait.cs │ │ ├── Color.cs │ │ ├── ComparableTrait.cs │ │ ├── ComparableType.cs │ │ ├── DurationType.cs │ │ ├── ErrorType.cs │ │ ├── Fix.cs │ │ ├── Form.cs │ │ ├── Int.cs │ │ ├── Iter.cs │ │ ├── IterTrait.cs │ │ ├── LengthTrait.cs │ │ ├── Lib.cs │ │ ├── List.cs │ │ ├── LocType.cs │ │ ├── Macro.cs │ │ ├── Map.cs │ │ ├── Meta.cs │ │ ├── Method.cs │ │ ├── Nil.cs │ │ ├── NumericTrait.cs │ │ ├── Pair.cs │ │ ├── Pipe.cs │ │ ├── PollTrait.cs │ │ ├── Port.cs │ │ ├── RangeTrait.cs │ │ ├── StackTrait.cs │ │ ├── String.cs │ │ ├── Sym.cs │ │ ├── Timestamp.cs │ │ ├── Trait.cs │ │ ├── UserMethod.cs │ │ └── UserType.cs │ ├── IO │ │ └── InputStream.cs │ ├── Net │ │ ├── Server.cs │ │ └── Stream.cs │ └── Term │ │ └── Key.cs │ ├── UserMethod.cs │ ├── VM.cs │ └── Value.cs └── tests ├── all-tests.sl ├── array-tests.sl ├── bind-tests.sl ├── char-tests.sl ├── defer-tests.sl ├── error-tests.sl ├── fib-tests.sl ├── fix-tests.sl ├── input.txt ├── int-tests.sl ├── io-tests.sl ├── iter-tests.sl ├── json-tests.sl ├── lib-tests.sl ├── lib.sl ├── list-tests.sl ├── logic-tests.sl ├── loop-tests.sl ├── map-tests.sl ├── method-tests.sl ├── pair-tests.sl ├── pipe-tests.sl ├── quote-tests.sl ├── string-tests.sl ├── thread-tests.sl ├── time-tests.sl └── type-tests.sl /LICENSE.txt: -------------------------------------------------------------------------------- 1 | Copyright 2023 codr7 2 | 3 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 4 | 5 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING, BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 8 | -------------------------------------------------------------------------------- /benchmarks/fib.sl: -------------------------------------------------------------------------------- 1 | (load "../fib.sl") 2 | 3 | (say (bench 100 (fib-rec 20))) 4 | (say (bench 10000 (fib-tail 45 0 1))) 5 | (say (bench 10000 (fib-list 45 (List 0)))) 6 | (say (bench 10000 (fib-map 45 {}))) 7 | -------------------------------------------------------------------------------- /benchmarks/python/.gitignore: -------------------------------------------------------------------------------- 1 | __pycache__ 2 | -------------------------------------------------------------------------------- /benchmarks/python/benchmark.py: -------------------------------------------------------------------------------- 1 | from timeit import Timer 2 | 3 | def benchmark(reps, setup, test): 4 | Timer(test, setup).timeit(reps) 5 | return Timer(test, setup).timeit(reps) 6 | -------------------------------------------------------------------------------- /benchmarks/python/fib.py: -------------------------------------------------------------------------------- 1 | from benchmark import benchmark 2 | 3 | print(benchmark(100, ''' 4 | def fib(n): 5 | return n if n < 2 else fib(n-1) + fib(n-2) 6 | ''', 7 | 'fib(20)')) 8 | 9 | print(benchmark(10000, ''' 10 | def fib(n, a, b): 11 | return a if n == 0 else b if n == 1 else fib(n-1, b, a+b) 12 | ''', 13 | 'fib(45, 0, 1)')) 14 | 15 | print(benchmark(10000, ''' 16 | def fib(n, lookup): 17 | if n in lookup: return lookup[n] 18 | result = n if n < 2 else fib(n-1, lookup) + fib(n-2, lookup) 19 | lookup[n] = result 20 | return result 21 | ''', 22 | 'fib(45, {})')) 23 | -------------------------------------------------------------------------------- /examples/aoc23/README.md: -------------------------------------------------------------------------------- 1 | # Advent of Code 2023 2 | 3 | ## intro 4 | [Sharpl](https://github.com/codr7/sharpl/tree/main) was created in an attempt to build a more ergonomic language for problem solving.
5 | 6 | For many years I used Common Lisp, the least painful alternative I could find; to solve the [AoC](https://adventofcode.com/). 7 | But as I spent more and more time hacking interpreters and designing my own tiny languages, a crazy idea started growing in my mind.
8 | 9 | Bending Common Lisp into a nice tool is not an easy task, it contains most of the bits and pieces but comes loaded with quirks for historical reasons. 10 | Scheme is too religious for my taste, Clojure even more so.
11 | 12 | There are other languages; but I have found none that offer the same kind of power in a coherent, modern package.
13 | 14 | I also like the idea of embedding languages, because having access to two complementing languages is a lot better than one. 15 | 16 | ## status 17 | It's a work in progress, the plan is to solve the first part of each problem and leave the second as an exercise. -------------------------------------------------------------------------------- /examples/aoc23/code1-1.sl: -------------------------------------------------------------------------------- 1 | (lib aoc23-1) 2 | 3 | (^find-digit [line] 4 | (char/digit (find-first:_ char/is-digit line))) 5 | 6 | (^read-line [line] 7 | (parse-int:_ (String (find-digit line) (find-digit (string/reverse line))))) 8 | 9 | (^calibrate [path] 10 | (io/do-read [f path] 11 | (sum (map read-line (io/lines f))*))) 12 | 13 | (check 55108 14 | (calibrate "input1")) -------------------------------------------------------------------------------- /examples/aoc23/code2-1.sl: -------------------------------------------------------------------------------- 1 | (lib aoc23-2) 2 | 3 | (^read-color [in out] 4 | (let [n:i (parse-int in) 5 | c (Sym (in i:_))] 6 | (out c (max (or (out c) 0) n)))) 7 | 8 | (^read-game [in out] 9 | (for [c (string/split in \,)] 10 | (read-color (string/trim c) out))) 11 | 12 | (^read-line [in] 13 | (let [i (_:find-first \: in) 14 | games (string/split (in (+ i 1):_) \;)] 15 | (reduce read-game games {}))) 16 | 17 | (^read-games [path] 18 | (io/do-read [f path] 19 | (enumerate 1 (map read-line (io/lines f))))) 20 | 21 | (^is-possible [game] 22 | (not (or (> (game 'red) 12) 23 | (> (game 'green) 13) 24 | (> (game 'blue) 14)))) 25 | 26 | (^sum-games [path] 27 | (let [all-games (read-games path) 28 | possible-games (filter (^[g] (is-possible (g 1))) all-games)] 29 | (sum (map 0 possible-games)*))) 30 | 31 | (check 2268 32 | (sum-games "input2")) -------------------------------------------------------------------------------- /examples/fire/README.md: -------------------------------------------------------------------------------- 1 | ``` 2 | git clone https://github.com/codr7/sharpl.git 3 | cd sharpl 4 | dotnet run examples/doom-fire/fire.sl 5 | ``` 6 | 7 | The basic idea originated in Doom's intro screen AFAIK.
8 | This one runs in the console, press any key to exit.
9 | A word of warning, I personally find it realistic enough to be slightly addictive.
10 | 11 | ![Screenshot](screenshot.png) -------------------------------------------------------------------------------- /examples/fire/fire.sl: -------------------------------------------------------------------------------- 1 | (var width (term/width) 2 | height (term/height) 3 | pixels (resize [] (* width height) 0) 4 | 5 | max-y (- height 1) 6 | max-fade 10) 7 | 8 | (^setup [] 9 | (for [i 0..width] 10 | (pixels i 255)) 11 | 12 | (term/clear-screen) 13 | (term/move-to 1 1) 14 | (term/flush)) 15 | 16 | (^cleanup [] 17 | (term/read-key) 18 | (term/reset) 19 | (term/clear-screen) 20 | (term/move-to 1 1) 21 | (term/flush) 22 | (term/restore)) 23 | 24 | (^render [] 25 | (let [i (- 1)] 26 | (for [_ 0..max-y] 27 | (for [x 0..width] 28 | (let [j (+ i width) 29 | v (pixels (inc i))] 30 | (if (and (> x 0) (< x (- width 1))) 31 | (set j (+ j (- 1 (rand-int 3))))) 32 | 33 | (pixels j (- v (rand-int (min max-fade (+ v 1)))))))) 34 | 35 | (set i (+ i width 1)) 36 | (term/move-to 1 1) 37 | 38 | (for [_ 0..height] 39 | (for [_ 0..width] 40 | (let [g (pixels (dec i)) 41 | r (else g 255 0) 42 | b (else (is g 255) 255 0)] 43 | (term/pick-back (rgb r g b)) 44 | (term/write \\s))) 45 | (term/write \\n))) 46 | 47 | (term/flush)) 48 | 49 | (^run [] 50 | (loop 51 | (if (term/poll-key) (return)) 52 | (render))) 53 | 54 | (setup) 55 | (run) 56 | (cleanup) -------------------------------------------------------------------------------- /examples/fire/screenshot.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/codr7/sharpl/1ca3295d7d1950297d02c78bf095d747011fd8e7/examples/fire/screenshot.png -------------------------------------------------------------------------------- /examples/remote-repl/README.md: -------------------------------------------------------------------------------- 1 | ## intro 2 | The goal of this project was to explore/design a networking API for [Sharpl](https://github.com/codr7/sharpl) by implementing a remote REPL. 3 | 4 | ## usage 5 | First start the server, the last argument is the password (NOTE: which is sent in cleartext over whatever network). 6 | 7 | ``` 8 | $ dotnet run examples/remote-repl/server 127.0.0.1 8080 xxx 9 | Listening on 127.0.0.1:8080 10 | New client 11 | (+ 1 2) 12 | 3 13 | ``` 14 | 15 | ``` 16 | $ dotnet run examples/remote-repl/client 127.0.0.1 8080 xxx 17 | Connected to 127.0.0.1:8080 18 | (+ 1 2) 19 | 3 20 | ``` -------------------------------------------------------------------------------- /examples/remote-repl/client: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/sharpl 2 | 3 | (if (not (is #ARG 3)) 4 | (say "Usage: client [Host Address] [Host Port] [Password]") 5 | (exit)) 6 | 7 | (var HOST (ARG 0) 8 | PORT (parse-int:_ (ARG 1)) 9 | PASSWORD (ARG 2) 10 | c (net/stream-port (net/connect HOST:PORT))) 11 | 12 | (say "Connected to " HOST:PORT) 13 | (c PASSWORD) 14 | 15 | (^run [] 16 | (loop 17 | (let [s (term/ask " ")] 18 | (if (is s _) (return)) 19 | (c s) 20 | (dump (c))))) 21 | 22 | (run) -------------------------------------------------------------------------------- /examples/remote-repl/server: -------------------------------------------------------------------------------- 1 | #!/usr/local/bin/sharpl 2 | 3 | (if (not (is #ARG 3)) 4 | (say "Usage: server [Address] [Port] [Password]") 5 | (exit)) 6 | 7 | (var HOST (ARG 0) 8 | PORT (parse-int:_ (ARG 1)) 9 | PASSWORD (ARG 2)) 10 | 11 | (var clients (List) 12 | s (net/accept (net/listen HOST:PORT))) 13 | 14 | (^handle-connect [c] 15 | (say "New client") 16 | 17 | (let [csp (net/stream-port c)] 18 | (else (= (csp) PASSWORD) 19 | (push clients csp) 20 | (say "Authentication failed") 21 | (close c)))) 22 | 23 | (^handle-request [c] 24 | (let [req (c) 25 | res (eval req)] 26 | (say " " req) 27 | (say res) 28 | (c res))) 29 | 30 | (say "Listening on " HOST:PORT) 31 | 32 | (loop 33 | (let [ready (poll [s clients*])] 34 | (else (is s ready) 35 | (handle-connect (s)) 36 | (handle-request ready)))) -------------------------------------------------------------------------------- /fib.sl: -------------------------------------------------------------------------------- 1 | (^fib-rec [n] 2 | (else (< n 2) n (+ (fib-rec (dec n)) (fib-rec (dec n))))) 3 | 4 | (^fib-tail [n a b] 5 | (else (> n 1) (return (fib-tail (dec n) b (+ a b))) (else (is n 0) a b))) 6 | 7 | (^ fib-list [n cache] 8 | (else (< n #cache) 9 | (cache n) 10 | (let [result (else (< n 2) n (+ (fib-list (dec n) cache) 11 | (fib-list (dec n) cache)))] 12 | (push cache result) 13 | result))) 14 | 15 | (^ fib-map [n cache] 16 | (or (cache n) 17 | (else (< n 2) 18 | n 19 | (let [result (+ (fib-map (- n 1) cache) 20 | (fib-map (- n 2) cache))] 21 | (cache n result) 22 | result)))) 23 | -------------------------------------------------------------------------------- /sharpl.csproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | 4 | Exe 5 | net8.0 6 | enable 7 | enable 8 | true 9 | 10 | 11 | 12 | Speed 13 | native 14 | true 15 | 16 | 17 | 18 | 19 | 20 | 21 | 22 | 23 | 24 | 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /sharpl.sln: -------------------------------------------------------------------------------- 1 |  2 | Microsoft Visual Studio Solution File, Format Version 12.00 3 | # Visual Studio Version 17 4 | VisualStudioVersion = 17.5.002.0 5 | MinimumVisualStudioVersion = 10.0.40219.1 6 | Project("{9A19103F-16F7-4668-BE54-9A1E7A4F7556}") = "sharpl", "sharpl.csproj", "{B8C2EB4D-EB0F-4002-9B71-7D4C1871B816}" 7 | EndProject 8 | Global 9 | GlobalSection(SolutionConfigurationPlatforms) = preSolution 10 | Debug|Any CPU = Debug|Any CPU 11 | Release|Any CPU = Release|Any CPU 12 | EndGlobalSection 13 | GlobalSection(ProjectConfigurationPlatforms) = postSolution 14 | {B8C2EB4D-EB0F-4002-9B71-7D4C1871B816}.Debug|Any CPU.ActiveCfg = Debug|Any CPU 15 | {B8C2EB4D-EB0F-4002-9B71-7D4C1871B816}.Debug|Any CPU.Build.0 = Debug|Any CPU 16 | {B8C2EB4D-EB0F-4002-9B71-7D4C1871B816}.Release|Any CPU.ActiveCfg = Release|Any CPU 17 | {B8C2EB4D-EB0F-4002-9B71-7D4C1871B816}.Release|Any CPU.Build.0 = Release|Any CPU 18 | EndGlobalSection 19 | GlobalSection(SolutionProperties) = preSolution 20 | HideSolutionNode = FALSE 21 | EndGlobalSection 22 | GlobalSection(ExtensibilityGlobals) = postSolution 23 | SolutionGuid = {A22ADFB1-DE90-4870-8FD9-57C004698AB2} 24 | EndGlobalSection 25 | EndGlobal 26 | -------------------------------------------------------------------------------- /src/Imports.cs: -------------------------------------------------------------------------------- 1 | global using Frame = (int RegisterIndex, int RegisterCount, int DeferOffset, int RestartOffset); 2 | global using PC = int; 3 | global using Stack = System.Collections.Generic.List; 4 | -------------------------------------------------------------------------------- /src/Program.cs: -------------------------------------------------------------------------------- 1 | using Sharpl; 2 | using Sharpl.Libs; 3 | using Ops = Sharpl.Ops; 4 | 5 | var vm = new VM(VM.DEFAULT); 6 | var mode = Mode.REPL; 7 | var argOffset = 0; 8 | 9 | if (args.Length > 0) { 10 | switch (args[0]) { 11 | case "dmit": 12 | mode = Mode.DMIT; 13 | argOffset += 2; 14 | break; 15 | case "repl": 16 | mode = Mode.REPL; 17 | argOffset++; 18 | break; 19 | case "run": 20 | mode = Mode.RUN; 21 | argOffset += 2; 22 | break; 23 | default: 24 | mode = Mode.RUN; 25 | argOffset = 1; 26 | break; 27 | } 28 | }; 29 | 30 | var startPC = vm.EmitPC; 31 | var vs = new Value[args.Length - argOffset]; 32 | for (var i = 0; i < vs.Length; i++) { vs[i] = Value.Make(Core.String, args[i + argOffset]); } 33 | vm.UserLib.Bind("ARG", Value.Make(Core.Array, vs)); 34 | 35 | if (mode == Mode.REPL) 36 | { 37 | new REPL().Run(vm); 38 | } 39 | else 40 | { 41 | if (args.Length > argOffset - 1) { vm.Load(args[argOffset - 1]); } 42 | vm.Emit(Ops.Stop.Make()); 43 | if (mode == Mode.RUN) { vm.Eval(startPC); } 44 | else if (mode == Mode.DMIT) { vm.Dmit(startPC); } 45 | } 46 | enum Mode { DMIT, RUN, REPL }; -------------------------------------------------------------------------------- /src/Sharpl/Call.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | using PC = int; 4 | 5 | public readonly record struct Call(UserMethod Target, PC ReturnPC, int FrameOffset, Loc Loc); -------------------------------------------------------------------------------- /src/Sharpl/Duration.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public readonly record struct Duration(int Months, TimeSpan Time) : IComparable 4 | { 5 | public DateTime AddTo(DateTime it) => it.AddMonths(Months).Add(Time); 6 | public Duration Add(Duration it) => new Duration(Months + it.Months, Time.Add(it.Time)); 7 | 8 | public Duration Divide(int d) => new Duration(Months / d, Time.Divide(d)); 9 | public int CompareTo(Duration other) 10 | { 11 | var r = Months.CompareTo(other.Months); 12 | if (r != 0) { return r; } 13 | return Time.CompareTo(other.Time); 14 | } 15 | 16 | public int Days => Time.Days; 17 | public int Hours => Time.Hours; 18 | public int Microseconds => Time.Microseconds; 19 | public int Milliseconds => Time.Milliseconds; 20 | public int Minutes => Time.Minutes; 21 | public Duration Multiply(int m) => new Duration(Months / m, Time.Multiply(m)); 22 | public int Seconds => Time.Seconds; 23 | public DateTime SubtractFrom(DateTime it) => it.AddMonths(-Months).Subtract(Time); 24 | public Duration Subtract(Duration it) => new Duration(Months - it.Months, Time.Subtract(it.Time)); 25 | public override string ToString() => $"(duration {Months} {Time})"; 26 | }; -------------------------------------------------------------------------------- /src/Sharpl/Env.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | using Libs; 4 | 5 | public class Env 6 | { 7 | private Dictionary bindings = new Dictionary(); 8 | 9 | public Env(Env? parent, HashSet ids) 10 | { 11 | Parent = parent; 12 | var uids = new HashSet(); 13 | 14 | for (var p = parent; p is Env; p = p.Parent) 15 | { 16 | foreach (var id in ids) 17 | { 18 | if (uids.Contains(id)) { continue; } 19 | 20 | if (p.bindings.TryGetValue(id, out var bval) && bval is Value b && b.Type == Core.Binding) 21 | { 22 | var v = b.CastUnbox(Core.Binding); 23 | if (v.FrameOffset != -1) { Bind(id, Value.Make(Core.Binding, new Register(v.FrameOffset + 1, v.Index))); } 24 | uids.Add(id); 25 | } 26 | } 27 | } 28 | } 29 | 30 | public Value? this[string id] 31 | { 32 | get => Find(id); 33 | 34 | set 35 | { 36 | if (value == null) { Unbind(id); } 37 | else { Bind(id, (Value)value); } 38 | } 39 | } 40 | 41 | public void Bind(string id, Value value) => 42 | bindings[id] = value; 43 | 44 | public void BindLib(Lib lib) => Bind(lib.Name, Value.Make(Core.Lib, lib)); 45 | 46 | public Macro BindMacro(string name, string[] args, Macro.BodyType body) 47 | { 48 | var m = new Macro(name, args, body); 49 | Bind(m.Name, Value.Make(Core.Macro, m)); 50 | return m; 51 | } 52 | 53 | public Method BindMethod(string name, string[] args, Method.BodyType body) 54 | { 55 | var m = new Method(name, args, body); 56 | Bind(m.Name, Value.Make(Core.Method, m)); 57 | return m; 58 | } 59 | 60 | public void BindType(AnyType t) => Bind(t.Name, Value.Make(Core.Meta, t)); 61 | 62 | public Value? Find(string id) => 63 | bindings.TryGetValue(id, out var value) ? value : Parent?.Find(id); 64 | 65 | public void Import(Env source) 66 | { 67 | foreach (var (id, v) in source.bindings) { Bind(id, v); } 68 | } 69 | 70 | public Env? Parent { get; } 71 | 72 | public bool Unbind(string id) => bindings.Remove(id); 73 | } -------------------------------------------------------------------------------- /src/Sharpl/Error.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public class Error : Exception 4 | { 5 | public readonly Loc Loc; 6 | 7 | public Error(string message, Loc loc) : base($"{loc} {message}") 8 | { 9 | Loc = loc; 10 | } 11 | }; 12 | 13 | public class EmitError : Error 14 | { 15 | public EmitError(string message, Loc loc) : base(message, loc) { } 16 | } 17 | 18 | public class EvalError : Error 19 | { 20 | public EvalError(string message, Loc loc) : base(message, loc) { } 21 | public virtual void AddRestarts(VM vm) { } 22 | } 23 | 24 | public class NonNumericError : EvalError 25 | { 26 | private PC retryPC; 27 | private Value[] stack; 28 | 29 | public NonNumericError(VM vm, Value value, PC retryPC, Value[] stack, Loc loc) : 30 | base($"Expected numeric value: {value.Dump(vm)}", loc) 31 | { 32 | this.retryPC = retryPC; 33 | this.stack = stack; 34 | } 35 | 36 | public override void AddRestarts(VM vm) 37 | { 38 | vm.AddRestart(vm.Intern("use-value"), 0, (vm, stack, target, arity, loc) => 39 | { 40 | var nv = vm.Term.Ask(vm, "Enter new value: "); 41 | stack.Push((Value)vm.Eval(nv!)!); 42 | stack.AddRange(this.stack); 43 | vm.Eval(retryPC, stack); 44 | }); 45 | } 46 | } 47 | 48 | public class ReadError : Error 49 | { 50 | public ReadError(string message, Loc loc) : base(message, loc) { } 51 | } 52 | public class UserError : EvalError 53 | { 54 | public readonly Value Value; 55 | 56 | public UserError(VM vm, Value value, Loc loc) : base(value.Say(vm), loc) 57 | { 58 | Value = value; 59 | } 60 | } -------------------------------------------------------------------------------- /src/Sharpl/Fix.cs: -------------------------------------------------------------------------------- 1 | using System.Runtime.CompilerServices; 2 | using System.Text; 3 | 4 | namespace Sharpl; 5 | 6 | using T = long; 7 | using UT = ulong; 8 | 9 | public static class Fix 10 | { 11 | public static readonly byte ExpBits = 4; 12 | public static readonly byte HeaderBits = (byte)(ExpBits + 1); 13 | 14 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 15 | public static UT Add(UT left, UT right) 16 | { 17 | var le = Exp(left); 18 | var re = Exp(right); 19 | 20 | return (le == re) 21 | ? Make(le, Val(left) + Val(right)) 22 | : Make(le, Val(left) + Val(right) * Scale(le) / Scale(re)); 23 | } 24 | 25 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 26 | public static bool Equals(UT left, UT right) => 27 | Val(left) * Scale(Exp(right)) == Val(right) * Scale(Exp(left)); 28 | 29 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 30 | public static UT Divide(UT left, UT right) => 31 | Make(Exp(left), Val(left) / (Val(right) / Scale(Exp(right)))); 32 | 33 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 34 | public static byte Exp(UT it) => (byte)(it & (UT)((1 << ExpBits) - 1)); 35 | 36 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 37 | public static UT Make(byte exp, T val) => 38 | (UT)(exp & ((1 << ExpBits) - 1)) + 39 | (UT)(((val < 0) ? 1 : 0) << ExpBits) + 40 | (UT)(((val < 0) ? -val : val) << HeaderBits); 41 | 42 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 43 | public static UT Multiply(UT left, UT right) => 44 | Make(Exp(left), Val(left) * Val(right) / Scale(Exp(right))); 45 | 46 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 47 | public static UT Negate(UT it) => Make(Exp(it), -Val(it)); 48 | 49 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 50 | public static bool Negative(UT it) => ((it >> ExpBits) & 1) == 1; 51 | 52 | private static readonly T[] scaleTable = [ 53 | 1, 54 | 10, 55 | 100, 56 | 1000, 57 | 10000, 58 | 100000, 59 | 1000000, 60 | 10000000, 61 | 100000000, 62 | 1000000000, 63 | 10000000000, 64 | 100000000000, 65 | 1000000000000, 66 | 10000000000000, 67 | 100000000000000]; 68 | 69 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 70 | public static T Scale(byte exp) => scaleTable[exp]; 71 | 72 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 73 | public static UT Subtract(UT left, UT right) 74 | { 75 | var le = Exp(left); 76 | var re = Exp(right); 77 | 78 | return (le == re) 79 | ? Make(le, Val(left) - Val(right)) 80 | : Make(re, Val(left) * Scale(re) / Scale(le) - Val(right)); 81 | } 82 | 83 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 84 | public static T Val(UT it) 85 | { 86 | UT v = it >> HeaderBits; 87 | return Negative(it) ? -(long)v : (long)v; 88 | } 89 | 90 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 91 | public static T Trunc(UT it) => Val(it) / Scale(Exp(it)); 92 | 93 | [MethodImpl(MethodImplOptions.AggressiveInlining)] 94 | public static T Frac(UT it) => Val(it) % Scale(Exp(it)); 95 | 96 | public static string ToString(UT it, bool forceZero = false) 97 | { 98 | var result = new StringBuilder(); 99 | if (Negative(it)) { result.Append('-'); } 100 | var t = Math.Abs(Trunc(it)); 101 | if (t > 0 || forceZero) { result.Append(t); } 102 | result.Append('.'); 103 | result.Append(Math.Abs(Frac(it))); 104 | return result.ToString(); 105 | } 106 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/And.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Forms; 2 | 3 | public class And : Form 4 | { 5 | public readonly Form Left; 6 | public readonly Form Right; 7 | 8 | public And(Form left, Form right, Loc loc) : base(loc) 9 | { 10 | Left = left; 11 | Right = right; 12 | } 13 | 14 | public override void CollectIds(HashSet result) 15 | { 16 | Left.CollectIds(result); 17 | Right.CollectIds(result); 18 | } 19 | 20 | public override void Emit(VM vm, Queue args) => 21 | vm.Emit(Ops.Push.Make(Form.Compose(vm, Left, Right, new Queue(), Loc))); 22 | 23 | public override void EmitCall(VM vm, Queue args) => 24 | Form.Compose(vm, Left, Right, args, Loc).EmitCall(vm, args, Loc); 25 | 26 | public override bool Equals(Form other) => 27 | (other is And f) && f.Left.Equals(Left) && f.Right.Equals(Right); 28 | 29 | public override bool Expand(VM vm, Queue args) 30 | { 31 | var result = false; 32 | if (Left.Expand(vm, args)) { result = true; } 33 | var l = args.PopLast(); 34 | if (Right.Expand(vm, args)) { result = true; } 35 | var r = args.PopLast(); 36 | args.Push(new And(l, r, Loc)); 37 | return result; 38 | } 39 | 40 | public override Form Quote(VM vm, Loc loc) => 41 | new And(Left.Quote(vm, loc), Right.Quote(vm, loc), loc); 42 | 43 | public override string Dump(VM vm) => $"{Left.Dump(vm)} & {Right.Dump(vm)}"; 44 | 45 | public override Form Unquote(VM vm, Loc loc) => 46 | new And(Left.Unquote(vm, loc), Right.Unquote(vm, loc), loc); 47 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Array.cs: -------------------------------------------------------------------------------- 1 | using System.Diagnostics; 2 | using System.Text; 3 | 4 | namespace Sharpl.Forms; 5 | 6 | public class Array : Form 7 | { 8 | public readonly Form[] Items; 9 | 10 | public Array(Form[] items, Loc loc) : base(loc) 11 | { 12 | Items = items; 13 | } 14 | 15 | public override void CollectIds(HashSet result) 16 | { 17 | foreach (var f in Items) { f.CollectIds(result); } 18 | } 19 | 20 | public override void Emit(VM vm, Queue args) 21 | { 22 | var splat = false; 23 | 24 | foreach (var f in Items) 25 | { 26 | if (f.IsSplat) 27 | { 28 | splat = true; 29 | break; 30 | } 31 | } 32 | 33 | if (splat) 34 | { 35 | var its = Items; 36 | Form cf = new Call(new Id("Array", Loc), its, Loc); 37 | args.PushFirst(cf); 38 | } 39 | else 40 | { 41 | vm.Emit(Ops.CreateArray.Make(Items.Length)); 42 | var i = 0; 43 | 44 | foreach (var f in Items) 45 | { 46 | vm.Emit(f); 47 | vm.Emit(Ops.SetArrayItem.Make(i)); 48 | i++; 49 | } 50 | } 51 | } 52 | 53 | public override bool Equals(Form other) 54 | { 55 | if (other is Array f) 56 | { 57 | if (Items.Length != f.Items.Length) { return false; } 58 | 59 | for (var i = 0; i < Math.Min(Items.Length, f.Items.Length); i++) 60 | { 61 | if (!Items[i].Equals(f.Items[i])) { return false; } 62 | } 63 | 64 | return true; 65 | } 66 | 67 | return false; 68 | } 69 | 70 | public override bool Expand(VM vm, Queue args) 71 | { 72 | var result = false; 73 | var newItems = new Form[Items.Length]; 74 | 75 | for (var i = 0; i < Items.Length; i++) 76 | { 77 | if (Items[i].Expand(vm, args)) { result = true; } 78 | newItems[i] = args.PopLast(); 79 | } 80 | 81 | args.Push(new Array(newItems, Loc)); 82 | return result; 83 | } 84 | 85 | public override Value? GetValue(VM vm) => 86 | Items.All(it => it is Literal) ? Value.Make(Libs.Core.Array, Items.Select(it => (it as Literal)!.Value.Copy()).ToArray()) : null; 87 | 88 | public override Form Quote(VM vm, Loc loc) => 89 | new Array(Items.Select(it => it.Quote(vm, loc)).ToArray(), loc); 90 | 91 | public override string Dump(VM vm) 92 | { 93 | var b = new StringBuilder(); 94 | b.Append('['); 95 | var i = 0; 96 | 97 | foreach (var v in Items) 98 | { 99 | if (i > 0) { b.Append(' '); } 100 | b.Append(v.Dump(vm)); 101 | i++; 102 | } 103 | 104 | b.Append(']'); 105 | return b.ToString(); 106 | } 107 | 108 | public override Form Unquote(VM vm, Loc loc) => 109 | new Array(Items.Select(it => it.Unquote(vm, loc)).ToArray(), loc); 110 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Binding.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Forms; 2 | 3 | public class Binding : Form 4 | { 5 | public readonly Register Register; 6 | public Binding(Register reg, Loc loc) : base(loc) 7 | { 8 | Register = reg; 9 | } 10 | 11 | public override void Emit(VM vm, Queue args) => 12 | vm.Emit(Ops.UnquoteRegister.Make(Register, Loc)); 13 | 14 | public override bool Equals(Form other) => other is Binding b && b.Register.Equals(Register); 15 | public override string Dump(VM vm) => $"{Register}"; 16 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Call.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Forms; 2 | 3 | using Sharpl.Libs; 4 | using System.Data; 5 | using System.Text; 6 | 7 | public class Call : Form 8 | { 9 | public readonly Form[] Args; 10 | public readonly Form Target; 11 | 12 | public Call(Form target, Form[] args, Loc loc) : base(loc) 13 | { 14 | Target = target; 15 | Args = args; 16 | } 17 | 18 | public override void CollectIds(HashSet result) 19 | { 20 | Target.CollectIds(result); 21 | foreach (var f in Args) { f.CollectIds(result); } 22 | } 23 | 24 | public override void Emit(VM vm, Queue args) 25 | { 26 | var cas = new Queue(Args); 27 | var t = Target; 28 | 29 | while (t is Pair pf) 30 | { 31 | if (pf.Right is Nil) 32 | { 33 | t = pf.Left; 34 | } 35 | else if (pf.Left is Nil) { t = pf.Right; } 36 | else { break; } 37 | } 38 | 39 | t.EmitCall(vm, cas); 40 | foreach (var a in cas) { args.Push(a); } 41 | t = Target; 42 | 43 | while (t is Pair pf) 44 | { 45 | if (pf.Right is Nil) 46 | { 47 | vm.Emit(Ops.Unzip.Make(Loc)); 48 | t = pf.Left; 49 | } 50 | else if (pf.Left is Nil) 51 | { 52 | vm.Emit(Ops.Unzip.Make(Loc)); 53 | t = pf.Right; 54 | vm.Emit(Ops.Swap.Make(Loc)); 55 | } else { break; } 56 | 57 | vm.Emit(Ops.Drop.Make(1)); 58 | } 59 | } 60 | 61 | public override bool Equals(Form other) 62 | { 63 | if (other is Call f) 64 | { 65 | if (!Target.Equals(f.Target) || Args.Length != f.Args.Length) { return false; } 66 | 67 | for (var i = 0; i < Math.Min(Args.Length, f.Args.Length); i++) 68 | { 69 | if (!Args[i].Equals(f.Args[i])) { return false; } 70 | } 71 | 72 | return true; 73 | } 74 | 75 | return false; 76 | } 77 | 78 | public override bool Expand(VM vm, Queue args) 79 | { 80 | var result = false; 81 | 82 | if (Target.GetValue(vm) is Value tv && tv.Type == Core.Meta && Args.All(a => a is Literal)) 83 | { 84 | var stack = new Stack(); 85 | foreach (var a in Args) { stack.Push((a as Literal)!.Value); } 86 | Core.Meta.Call(vm, stack, tv, Args.Length, vm.NextRegisterIndex, false, Loc); 87 | if (stack.Pop() is Value v) { args.Push(new Literal(v, Loc)); } 88 | else { throw new EmitError("Expected value", Loc); } 89 | result = true; 90 | } 91 | else 92 | { 93 | if (Target.Expand(vm, args)) { result = true; } 94 | var t = args.PopLast(); 95 | var callArgs = new Form[Args.Length]; 96 | 97 | for (var i = 0; i < Args.Length; i++) 98 | { 99 | if (Args[i].Expand(vm, args)) { result = true; } 100 | callArgs[i] = args.PopLast(); 101 | } 102 | 103 | args.Push(new Call(t, callArgs, Loc)); 104 | } 105 | 106 | return result; 107 | } 108 | 109 | public override Form Quote(VM vm, Loc loc) => 110 | new Literal(Value.Make(Libs.Core.Form, new Call(Target.Quote(vm, loc), Args.Select(a => a.Quote(vm, loc)).ToArray(), loc)), Loc); 111 | 112 | public override string Dump(VM vm) 113 | { 114 | var b = new StringBuilder(); 115 | b.Append('('); 116 | b.Append(Target.Dump(vm)); 117 | foreach (var a in Args) { b.Append($" {a.Dump(vm)}"); } 118 | b.Append(')'); 119 | return b.ToString(); 120 | } 121 | 122 | public override Form Unquote(VM vm, Loc loc) 123 | { 124 | return new Call(Target.Unquote(vm, loc), Args.Select(a => a.Unquote(vm, loc)).ToArray(), loc); 125 | } 126 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Id.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Libs; 2 | 3 | namespace Sharpl.Forms; 4 | 5 | public class Id : Form 6 | { 7 | public static Value? FindId(string name, Env env, Loc loc) 8 | { 9 | while (true) 10 | { 11 | var i = name.IndexOf('/'); 12 | if (i <= 0) { break; } 13 | var ln = name.Substring(0, i); 14 | var lv = env[ln]; 15 | if (lv is null) { return null; } 16 | env = ((Value)lv).Cast(Core.Lib, loc); 17 | name = name.Substring(i + 1); 18 | } 19 | 20 | return env[name]; 21 | } 22 | 23 | public static Value GetId(string name, Env env, Loc loc) 24 | { 25 | if (FindId(name, env, loc) is Value v) { return v; } 26 | throw new EmitError($"Unknown id: {name}", loc); 27 | } 28 | 29 | public readonly string Name; 30 | 31 | public Id(string name, Loc loc) : base(loc) 32 | { 33 | Name = name; 34 | } 35 | 36 | public override void CollectIds(HashSet result) => 37 | result.Add(Name); 38 | 39 | public override void Emit(VM vm, Queue args) 40 | { 41 | if (GetId(Name, vm.Env, Loc) is Value v) { args.PushFirst(new Literal(v, Loc)); } 42 | else { throw new EmitError($"Unknown id: {Name}", Loc); } 43 | } 44 | 45 | public override void EmitCall(VM vm, Queue args) 46 | { 47 | if (GetId(Name, vm.Env, Loc) is Value v) { v.EmitCall(vm, args, Loc); } 48 | else { throw new EmitError($"Unknown id: {Name}", Loc); } 49 | } 50 | 51 | public override bool Equals(Form other) => 52 | (other is Id f) ? f.Name.Equals(Name) : false; 53 | 54 | public override Value? GetValue(VM vm) => FindId(Name, vm.Env, Loc); 55 | 56 | public override Form Quote(VM vm, Loc loc) => 57 | new Literal(Value.Make(Core.Sym, vm.Intern(Name)), loc); 58 | 59 | public override string Dump(VM vm) => Name; 60 | public override Form Unquote(VM vm, Loc loc) => GetId(Name, vm.Env, loc).Unquote(vm, loc); 61 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Literal.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Forms; 2 | 3 | public class Literal : Form 4 | { 5 | public readonly Value Value; 6 | 7 | public Literal(Value value, Loc loc) : base(loc) 8 | { 9 | Value = value; 10 | } 11 | 12 | public override void Emit(VM vm, Queue args) => Value.Emit(vm, args, Loc); 13 | public override void EmitCall(VM vm, Queue args) => Value.EmitCall(vm, args, Loc); 14 | public override bool Equals(Form other) => (other is Literal l) && l.Value.Equals(Value); 15 | public override Value? GetValue(VM vm) => Value.Copy(); 16 | public override string Dump(VM vm) => Value.Dump(vm); 17 | public override Form Unquote(VM vm, Loc loc) => Value.Unquote(vm, loc); 18 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Map.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Forms; 2 | 3 | using System.Text; 4 | 5 | public class Map : Form 6 | { 7 | public readonly Form[] Items; 8 | 9 | public Map(Form[] items, Loc loc) : base(loc) 10 | { 11 | Items = items; 12 | } 13 | 14 | public override void CollectIds(HashSet result) 15 | { 16 | foreach (var f in Items) { f.CollectIds(result); } 17 | } 18 | 19 | public override void Emit(VM vm, Queue args) 20 | { 21 | var callConstructor = false; 22 | 23 | foreach (var f in Items) 24 | { 25 | if (!(f is Pair)) 26 | { 27 | callConstructor = true; 28 | break; 29 | } 30 | } 31 | 32 | if (callConstructor) { args.PushFirst(new Call(new Id("Map", Loc), Items, Loc)); } 33 | else 34 | { 35 | vm.Emit(Ops.CreateMap.Make(Items.Length)); 36 | var i = 0; 37 | 38 | foreach (var f in Items) 39 | { 40 | if (f is Pair pf) 41 | { 42 | vm.Emit(pf.Left); 43 | vm.Emit(pf.Right); 44 | } 45 | else { vm.Emit(f); } 46 | 47 | vm.Emit(Ops.SetMapItem.Make()); 48 | i++; 49 | } 50 | } 51 | } 52 | 53 | public override bool Equals(Form other) 54 | { 55 | if (other is Map f) 56 | { 57 | if (Items.Length != f.Items.Length) { return false; } 58 | 59 | for (var i = 0; i < Math.Min(Items.Length, f.Items.Length); i++) 60 | { 61 | if (!Items[i].Equals(f.Items[i])) { return false; } 62 | } 63 | 64 | return true; 65 | } 66 | 67 | return false; 68 | } 69 | 70 | public override bool Expand(VM vm, Queue args) 71 | { 72 | var result = false; 73 | var newItems = new Form[Items.Length]; 74 | 75 | for (var i = 0; i < Items.Length; i++) 76 | { 77 | if (Items[i].Expand(vm, args)) { result = true; } 78 | newItems[i] = args.PopLast(); 79 | } 80 | 81 | args.Push(new Map(newItems, Loc)); 82 | return result; 83 | } 84 | 85 | public override Value? GetValue(VM vm) 86 | { 87 | var its = Items.Select(it => it.GetValue(vm)); 88 | 89 | return its.All(it => it is not null) 90 | ? Value.Make(Libs.Core.Map, 91 | new OrderedMap(its.Select(it => ((Value)it!).CastUnbox(Libs.Core.Pair)).ToArray())) 92 | : null; 93 | } 94 | 95 | public override Form Quote(VM vm, Loc loc) => 96 | new Map(Items.Select(it => it.Quote(vm, loc)).ToArray(), loc); 97 | 98 | public override string Dump(VM vm) 99 | { 100 | var b = new StringBuilder(); 101 | b.Append('{'); 102 | var i = 0; 103 | 104 | foreach (var f in Items) 105 | { 106 | if (i > 0) { b.Append(' '); } 107 | b.Append(f.Dump(vm)); 108 | i++; 109 | } 110 | 111 | b.Append('}'); 112 | return b.ToString(); 113 | } 114 | 115 | public override Form Unquote(VM vm, Loc loc) => 116 | new Map(Items.Select(it => it.Unquote(vm, loc)).ToArray(), loc); 117 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Nil.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Forms; 2 | 3 | public class Nil : Form 4 | { 5 | public Nil(Loc loc) : base(loc) { } 6 | public override void Emit(VM vm, Queue args) => args.PushFirst(new Literal(Value._, Loc)); 7 | public override bool Equals(Form other) => other is Nil; 8 | public override bool IsSplat => false; 9 | public override string Dump(VM vm) => "_"; 10 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Pair.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Libs; 2 | 3 | namespace Sharpl.Forms; 4 | 5 | public class Pair : Form 6 | { 7 | public readonly Form Left; 8 | public readonly Form Right; 9 | 10 | public Pair(Form left, Form right, Loc loc) : base(loc) 11 | { 12 | Left = left; 13 | Right = right; 14 | } 15 | 16 | public override void CollectIds(HashSet result) 17 | { 18 | Left.CollectIds(result); 19 | Right.CollectIds(result); 20 | } 21 | 22 | public override void Emit(VM vm, Form.Queue args) 23 | { 24 | vm.Emit(Left); 25 | vm.Emit(Right); 26 | vm.Emit(Ops.CreatePair.Make(Loc)); 27 | } 28 | 29 | public override bool Equals(Form other) => 30 | (other is And f) ? f.Left.Equals(Left) && f.Right.Equals(Right) : false; 31 | 32 | public override bool Expand(VM vm, Queue args) 33 | { 34 | var result = false; 35 | if (Left.Expand(vm, args)) { result = true; } 36 | var l = args.PopLast(); 37 | if (Right.Expand(vm, args)) { result = true; } 38 | var r = args.PopLast(); 39 | args.Push(new Pair(l, r, Loc)); 40 | return result; 41 | } 42 | 43 | public override Value? GetValue(VM vm) => 44 | (Left.GetValue(vm) is Value lv && Right.GetValue(vm) is Value rv) 45 | ? Value.Make(Core.Pair, (lv.Copy(), rv.Copy())) 46 | : null; 47 | 48 | public override Form Quote(VM vm, Loc loc) => 49 | new Pair(Left.Quote(vm, loc), Right.Quote(vm, loc), loc); 50 | 51 | public override string Dump(VM vm) => $"{Left.Dump(vm)}:{Right.Dump(vm)}"; 52 | 53 | public override Form Unquote(VM vm, Loc loc) => 54 | new Pair(Left.Unquote(vm, loc), Right.Unquote(vm, loc), loc); 55 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Quote.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Forms; 2 | 3 | public class QuoteForm : Form 4 | { 5 | public readonly Form Target; 6 | 7 | public QuoteForm(Form target, Loc loc) : base(loc) 8 | { 9 | Target = target; 10 | } 11 | 12 | public override void CollectIds(HashSet result) => Target.CollectIds(result); 13 | public override void Emit(VM vm, Queue args) => args.PushFirst(Target.Quote(vm, Loc)); 14 | public override void EmitCall(VM vm, Queue args) => Target.Quote(vm, Loc).EmitCall(vm, args); 15 | public override bool Equals(Form other) => (other is QuoteForm f) && f.Target.Equals(Target); 16 | 17 | public override bool Expand(VM vm, Queue args) 18 | { 19 | var result = Target.Expand(vm, args); 20 | args.Push(new QuoteForm(args.PopLast(), Loc)); 21 | return result; 22 | } 23 | 24 | public override bool IsSplat => Target.IsSplat; 25 | public override Form Quote(VM vm, Loc loc) => new QuoteForm(this, loc); 26 | public override string Dump(VM vm) => $"{Target.Dump(vm)}"; 27 | public override Form Unquote(VM vm, Loc loc) => Target; 28 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Splat.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Forms; 2 | 3 | public class Splat : Form 4 | { 5 | public readonly Form Target; 6 | public Splat(Form target, Loc loc) : base(loc) { Target = target; } 7 | 8 | public override void Emit(VM vm, Queue args) 9 | { 10 | vm.Emit(Target); 11 | vm.Emit(Ops.Splat.Make(Loc)); 12 | } 13 | 14 | public override bool Equals(Form other) => (other is Splat f) ? f.Target.Equals(Target) : false; 15 | 16 | public override bool IsSplat => true; 17 | public override Form Quote(VM vm, Loc loc) => new Splat(Target.Quote(vm, loc), loc); 18 | public override string Dump(VM vm) => $"{Target.Dump(vm)}*"; 19 | public override Form Unquote(VM vm, Loc loc) => new Splat(Target, loc); 20 | } -------------------------------------------------------------------------------- /src/Sharpl/Forms/Unquote.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Forms; 2 | 3 | public class UnquoteForm : Form 4 | { 5 | public readonly Form Target; 6 | 7 | public UnquoteForm(Form target, Loc loc) : base(loc) 8 | { 9 | Target = target; 10 | } 11 | 12 | public override void CollectIds(HashSet result) => Target.CollectIds(result); 13 | public override void Emit(VM vm, Queue args) => args.PushFirst(Target.Unquote(vm, Loc)); 14 | public override bool Equals(Form other) => (other is UnquoteForm f) ? f.Target.Equals(Target) : false; 15 | 16 | public override bool Expand(VM vm, Queue args) 17 | { 18 | var result = Target.Expand(vm, args); 19 | args.Push(new UnquoteForm(args.PopLast(), Loc)); 20 | return result; 21 | } 22 | 23 | public override bool IsSplat => Target.IsSplat; 24 | public override Form Quote(VM vm, Loc loc) => Target.Unquote(vm, loc); 25 | public override string Dump(VM vm) => $",{Target.Dump(vm)}"; 26 | public override Form Unquote(VM vm, Loc loc) => new UnquoteForm(this, loc); 27 | } -------------------------------------------------------------------------------- /src/Sharpl/Iter.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | using System.Collections; 4 | 5 | public abstract class Iter 6 | { 7 | public virtual string Dump(VM vm) => $"{this}"; 8 | public abstract Value? Next(VM vm, Loc loc); 9 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Core/CharRange.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.Core; 2 | 3 | public class CharRange : Iter 4 | { 5 | public readonly char? Max; 6 | public readonly int Stride; 7 | private char value; 8 | 9 | public CharRange(char min, char? max, int stride) 10 | { 11 | Max = max; 12 | Stride = stride; 13 | value = (char)(min - (char)stride); 14 | } 15 | 16 | public override Value? Next(VM vm, Loc loc) 17 | { 18 | if (Max is char mv && value + 1 < mv) 19 | { 20 | value += (char)Stride; 21 | return Value.Make(Libs.Core.Char, value); 22 | } 23 | 24 | return null; 25 | } 26 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Core/EnumeratorItems.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.Core; 2 | 3 | public class EnumeratorItems(IEnumerator Source) : Iter 4 | { 5 | public override Value? Next(VM vm, Loc loc) => Source.MoveNext() ? Source.Current : null; 6 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Core/FixRange.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.Core; 2 | 3 | public class FixRange : Iter 4 | { 5 | public readonly long? MaxVal; 6 | public readonly ulong Stride; 7 | private ulong value; 8 | 9 | public FixRange(ulong min, ulong? max, ulong stride) 10 | { 11 | MaxVal = (max == null) ? null : Fix.Val((ulong)max); 12 | Stride = stride; 13 | value = Fix.Subtract(min, stride); 14 | } 15 | 16 | public override Value? Next(VM vm, Loc loc) 17 | { 18 | var v = Fix.Add(value, Stride); 19 | 20 | if (Fix.Val(v) < MaxVal) 21 | { 22 | value = v; 23 | return Value.Make(Libs.Core.Fix, value); 24 | } 25 | 26 | return null; 27 | } 28 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Core/IntRange.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.Core; 2 | 3 | public class IntRange : Iter 4 | { 5 | public readonly int Min; 6 | public readonly int? Max; 7 | public readonly int Stride; 8 | private int value; 9 | 10 | public IntRange(int min, int? max, int stride) 11 | { 12 | Min = min; 13 | Max = max; 14 | Stride = stride; 15 | value = min - stride; 16 | } 17 | 18 | public override Value? Next(VM vm, Loc loc) 19 | { 20 | if (Max is null || value + 1 < Max) 21 | { 22 | value += Stride; 23 | return Value.Make(Libs.Core.Int, value); 24 | } 25 | 26 | return null; 27 | } 28 | 29 | public override string Dump(VM vm) => 30 | $"(range {Min} {((Max is null) ? "_" : Max)} {Stride})"; 31 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Core/Nil.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.Core; 2 | 3 | public class Nil : Iter 4 | { 5 | public static readonly Nil Instance = new Nil(); 6 | public override Value? Next(VM vm, Loc loc) => null; 7 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Core/PairItems.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.Core; 2 | 3 | public class PairItems : Iter 4 | { 5 | private Value? value; 6 | 7 | public PairItems(Value start) 8 | { 9 | value = start; 10 | } 11 | 12 | public override Value? Next(VM vm, Loc loc) 13 | { 14 | if (value is Value v) 15 | { 16 | if (v.Type == Libs.Core.Pair) 17 | { 18 | var p = v.CastUnbox(Libs.Core.Pair); 19 | value = p.Item2; 20 | return p.Item1; 21 | } 22 | else 23 | { 24 | value = null; 25 | return v; 26 | } 27 | 28 | } 29 | 30 | return null; 31 | } 32 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Core/PipeItems.cs: -------------------------------------------------------------------------------- 1 | using System.Threading.Channels; 2 | 3 | namespace Sharpl.Iters.Core; 4 | 5 | public class PipeItems(ChannelReader Source) : Iter 6 | { 7 | public override Value? Next(VM vm, Loc loc) => 8 | Task.Run(async () => await Source.ReadAsync()).Result; 9 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Core/PortItems.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.Core; 2 | 3 | public class PortItems(Port source) : Iter 4 | { 5 | public override Value? Next(VM vm, Loc loc) => Task.Run(async () => await source.Read(vm, loc)).Result; 6 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Core/Zip.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.Core; 2 | 3 | public class Zip(Iter[] Sources) : Iter 4 | { 5 | public override Value? Next(VM vm, Loc loc) 6 | { 7 | var vs = Sources.Select(it => it.Next(vm, loc)).ToArray(); 8 | 9 | #pragma warning disable CS8629 10 | return vs.Any(v => v is null) ? null : vs 11 | .Select(v => (Value)v) 12 | .Reverse() 13 | .Aggregate((a, v) => Value.Make(Libs.Core.Pair, (v, a))); 14 | #pragma warning restore CS8629 15 | } 16 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/FilterItems.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters; 2 | 3 | public class FilterItems : Iter 4 | { 5 | public readonly Value Predicate; 6 | public readonly Iter Source; 7 | 8 | public FilterItems(Value predicate, Iter source) 9 | { 10 | Predicate = predicate; 11 | Source = source; 12 | } 13 | 14 | public override Value? Next(VM vm, Loc loc) 15 | { 16 | while (Source.Next(vm, loc) is Value v) 17 | { 18 | var stack = new Stack(); 19 | stack.Push(v); 20 | Predicate.Call(vm, stack, 1, vm.NextRegisterIndex, true, loc); 21 | if ((bool)stack.Pop()) { return v; } 22 | } 23 | 24 | return null; 25 | } 26 | 27 | public override string Dump(VM vm) => $"(filter {Predicate.Dump(vm)} {Source.Dump(vm)})"; 28 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/IO/StreamLines.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.IO; 2 | 3 | using Sharpl.Libs; 4 | 5 | public class StreamLines : Sharpl.Iter 6 | { 7 | public readonly TextReader Reader; 8 | 9 | public StreamLines(TextReader reader) 10 | { 11 | Reader = reader; 12 | } 13 | 14 | public override Value? Next(VM vm, Loc loc) 15 | { 16 | var line = Reader.ReadLine(); 17 | return (line == null) ? null : Value.Make(Core.String, line); 18 | } 19 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/MapItems.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters; 2 | 3 | public class MapItems : Iter 4 | { 5 | public readonly Value Result; 6 | public readonly Iter[] Sources; 7 | 8 | public MapItems(Value result, Iter[] sources) 9 | { 10 | Result = result; 11 | Sources = sources; 12 | } 13 | 14 | public override Value? Next(VM vm, Loc loc) 15 | { 16 | var stack = new Stack(); 17 | 18 | for (int i = 0; i < Sources.Length; i++) 19 | { 20 | if (Sources[i].Next(vm, loc) is Value v) { stack.Push(v); } 21 | else { return null; } 22 | } 23 | 24 | Result.Call(vm, stack, stack.Count, vm.NextRegisterIndex, true, loc); 25 | return stack.Pop(); 26 | } 27 | 28 | public override string Dump(VM vm) => 29 | $"(map {Result.Dump(vm)} [{string.Join(' ', Sources.Select(s => s.Dump(vm)).ToArray())}])"; 30 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Net/ServerConnections.cs: -------------------------------------------------------------------------------- 1 | using System.Threading.Channels; 2 | 3 | namespace Sharpl.Iters.Core; 4 | 5 | public class ServerConnections : Iter 6 | { 7 | public readonly ChannelReader Source; 8 | 9 | public ServerConnections(ChannelReader source) 10 | { 11 | Source = source; 12 | } 13 | 14 | public override Value? Next(VM vm, Loc loc) => Source.TryRead(out var v) ? v : null; 15 | } -------------------------------------------------------------------------------- /src/Sharpl/Iters/Time/TimeRange.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Iters.Core; 2 | 3 | public class TimeRange : Iter 4 | { 5 | public readonly DateTime Min; 6 | public readonly DateTime? Max; 7 | public readonly Duration Stride; 8 | private DateTime value; 9 | 10 | public TimeRange(DateTime min, DateTime? max, Duration stride) 11 | { 12 | Min = min; 13 | Max = max; 14 | Stride = stride; 15 | value = stride.SubtractFrom(min); 16 | } 17 | 18 | public override Value? Next(VM vm, Loc loc) 19 | { 20 | var nv = Stride.AddTo(value); 21 | 22 | if (Max is null || nv.CompareTo(Max) < 0) 23 | { 24 | value = nv; 25 | return Value.Make(Libs.Core.Timestamp, value); 26 | } 27 | 28 | return null; 29 | } 30 | 31 | public override string Dump(VM vm) => 32 | $"(range {Min} {((Max is null) ? "_" : Max)} {Stride})"; 33 | } -------------------------------------------------------------------------------- /src/Sharpl/Label.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | using PC = int; 4 | 5 | public class Label 6 | { 7 | public PC PC 8 | { 9 | #pragma warning disable CS8629 10 | get => (PC)pc; 11 | #pragma warning restore CS8629 12 | set => pc = value; 13 | } 14 | 15 | public Label(PC? pc = null) 16 | { 17 | if (pc != null) { PC = (PC)pc; } 18 | } 19 | 20 | public override string ToString() => $"@{PC}"; 21 | 22 | private PC? pc; 23 | } -------------------------------------------------------------------------------- /src/Sharpl/Lib.cs: -------------------------------------------------------------------------------- 1 | using System.ComponentModel; 2 | 3 | namespace Sharpl; 4 | public class Lib : Env 5 | { 6 | public Lib(string name, Env? parent, HashSet ids) : base(parent, ids) 7 | { 8 | Name = name; 9 | } 10 | 11 | public void Init(VM vm, Loc loc) 12 | { 13 | vm.Env.BindLib(this); 14 | 15 | vm.DoEnv(this, loc, () => 16 | { 17 | OnInit(vm); 18 | }); 19 | } 20 | 21 | public string Name { get; } 22 | 23 | public override string ToString() => $"(Lib {Name})"; 24 | 25 | protected virtual void OnInit(VM vm) { } 26 | } -------------------------------------------------------------------------------- /src/Sharpl/Libs/Char.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Libs; 2 | 3 | public class Char : Lib 4 | { 5 | public Char() : base("char", null, []) 6 | { 7 | BindMethod("digit", ["ch"], (vm, stack, target, arity, loc) => 8 | stack.Push(Core.Int, stack.Pop().CastUnbox(Core.Char, loc) - '0')); 9 | 10 | BindMethod("down", ["in"], (vm, stack, target, arity, loc) => 11 | { 12 | var c = stack.Pop().CastUnbox(Core.Char, loc); 13 | stack.Push(Core.Char, char.ToLower(c)); 14 | }); 15 | 16 | BindMethod("is-digit", ["ch"], (vm, stack, target, arity, loc) => 17 | stack.Push(Core.Bit, char.IsDigit(stack.Pop().CastUnbox(Core.Char, loc)))); 18 | 19 | BindMethod("up", ["in"], (vm, stack, target, arity, loc) => 20 | { 21 | var c = stack.Pop().CastUnbox(Core.Char, loc); 22 | stack.Push(Core.Char, char.ToUpper(c)); 23 | }); 24 | } 25 | } -------------------------------------------------------------------------------- /src/Sharpl/Libs/Fix.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Libs; 2 | 3 | public class Fix : Lib 4 | { 5 | public Fix() : base("fix", null, []) 6 | { 7 | BindMethod("to-int", ["value"], (vm, stack, target, arity, loc) => 8 | stack.Push(Core.Int, (int)Sharpl.Fix.Trunc(stack.Pop().CastUnbox(Core.Fix, loc)))); 9 | } 10 | } -------------------------------------------------------------------------------- /src/Sharpl/Libs/IO.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Iters.IO; 2 | using Sharpl.Types.IO; 3 | 4 | namespace Sharpl.Libs; 5 | 6 | public class IO : Lib 7 | { 8 | public static readonly InputStreamType InputStream = new InputStreamType("InputStream", [Core.Any]); 9 | 10 | public IO(VM vm) : base("io", null, []) 11 | { 12 | BindType(InputStream); 13 | 14 | Bind("IN", Value.Make(IO.InputStream, Console.In)); 15 | 16 | BindMacro("do-read", ["path"], (vm, target, args, loc) => 17 | { 18 | if (args.TryPop() is Form afs) 19 | { 20 | if (afs is Forms.Array af) 21 | { 22 | if (af.Items.Length < 2) 23 | { 24 | throw new EmitError("Missing args", loc); 25 | } 26 | 27 | vm.DoEnv(new Env(vm.Env, args.CollectIds()), loc, () => 28 | { 29 | var reg = vm.AllocRegister(); 30 | var a0 = af.Items[0]; 31 | 32 | if (a0 is Forms.Id id) 33 | { 34 | vm.Env.Bind(id.Name, Value.Make(Core.Binding, new Register(0, reg))); 35 | } 36 | else 37 | { 38 | throw new EmitError("Expected identifier: {a0}", a0.Loc); 39 | } 40 | 41 | var startPC = vm.EmitPC; 42 | vm.Emit(af.Items[1]); 43 | vm.Emit(Ops.OpenInputStream.Make(0, reg, loc)); 44 | args.Emit(vm); 45 | }); 46 | } 47 | else 48 | { 49 | throw new EmitError("Invalid args", loc); 50 | } 51 | } 52 | else 53 | { 54 | throw new EmitError("Missing args", loc); 55 | } 56 | }); 57 | 58 | BindMethod("lines", ["in"], (vm, stack, target, arity, loc) => 59 | { 60 | var s = stack.Pop().Cast(InputStream); 61 | stack.Push(Value.Make(Core.Iter, new StreamLines(s))); 62 | }); 63 | } 64 | } -------------------------------------------------------------------------------- /src/Sharpl/Libs/Json.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Libs; 2 | 3 | public class Json : Lib 4 | { 5 | public Json() : base("json", null, []) 6 | { 7 | BindMethod("decode", ["value"], (vm, stack, target, arity, loc) => 8 | { 9 | var jsLoc = new Loc("json"); 10 | var v = Sharpl.Json.ReadValue(vm, new StringReader(stack.Pop().Cast(Core.String)), ref jsLoc); 11 | stack.Push((v is null) ? Value._ : (Value)v); 12 | }); 13 | 14 | BindMethod("encode", ["value"], (vm, stack, target, arity, loc) => 15 | stack.Push(Core.String, stack.Pop().ToJson(loc)) 16 | ); 17 | } 18 | } -------------------------------------------------------------------------------- /src/Sharpl/Libs/Net.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Net; 2 | using Sharpl.Types.Net; 3 | using System.Net; 4 | using System.Net.Sockets; 5 | using System.Threading.Channels; 6 | using static System.Runtime.InteropServices.JavaScript.JSType; 7 | 8 | namespace Sharpl.Libs; 9 | 10 | public class Net : Lib 11 | { 12 | public static readonly ServerType Server = new ServerType("Server", [Core.Any]); 13 | public static readonly StreamType Stream = new StreamType("Stream", [Core.Any]); 14 | 15 | public Net() : base("net", null, []) 16 | { 17 | BindType(Server); 18 | BindType(Stream); 19 | 20 | BindMethod("connect", ["addr"], (vm, stack, target, arity, loc) => 21 | { 22 | var v = stack.Pop().CastUnbox(Core.Pair, loc); 23 | var a = IPAddress.Parse(v.Item1.Cast(Core.String, loc)); 24 | var c = new TcpClient(); 25 | c.Connect(a, v.Item2.CastUnbox(Core.Int, loc)); 26 | stack.Push(Stream, c.GetStream()); 27 | }); 28 | 29 | BindMethod("accept", ["server"], (vm, stack, target, arity, loc) => 30 | { 31 | var s = stack.Pop().Cast(Server, loc); 32 | var c = Channel.CreateUnbounded(); 33 | 34 | Task.Run(async () => 35 | { 36 | while (await s.AcceptTcpClientAsync() is TcpClient tc) 37 | { 38 | await c.Writer.WriteAsync(Value.Make(Stream, tc.GetStream())); 39 | } 40 | }); 41 | 42 | stack.Push(Core.Pipe, c); 43 | }); 44 | 45 | BindMethod("listen", ["addr"], (vm, stack, target, arity, loc) => 46 | { 47 | var v = stack.Pop().CastUnbox(Core.Pair, loc); 48 | var a = IPAddress.Parse(v.Item1.Cast(Core.String, loc)); 49 | var s = new TcpListener(a, v.Item2.CastUnbox(Core.Int, loc)); 50 | s.Start(); 51 | stack.Push(Server, s); 52 | }); 53 | 54 | BindMethod("stream-port", ["it"], (vm, stack, target, arity, loc) => 55 | { 56 | var s = stack.Pop().Cast(Stream, loc); 57 | stack.Push(Core.Port, new StreamPort(s)); 58 | }); 59 | } 60 | } -------------------------------------------------------------------------------- /src/Sharpl/Libs/String.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | using System.Text.RegularExpressions; 3 | 4 | namespace Sharpl.Libs; 5 | 6 | public class String : Lib 7 | { 8 | private static string Stringify(Value v, Loc loc) => 9 | (v.Type == Core.Char) ? $"{v.CastUnbox(Core.Char)}" : v.Cast(Core.String, loc); 10 | 11 | public String() : base("string", null, []) 12 | { 13 | BindMethod("down", ["in"], (vm, stack, target, arity, loc) => 14 | { 15 | var s = stack.Pop().Cast(Core.String, loc); 16 | stack.Push(Core.String, s.ToLower()); 17 | }); 18 | 19 | BindMethod("join", ["sep"], (vm, stack, target, arity, loc) => 20 | { 21 | stack.Reverse(arity); 22 | var sep = stack.Pop(); 23 | var res = new StringBuilder(); 24 | arity--; 25 | 26 | while (arity > 0) 27 | { 28 | if (sep.Type != Core.Nil && res.Length > 0) { sep.Say(vm, res); } 29 | stack.Pop().Say(vm, res); 30 | arity--; 31 | } 32 | 33 | stack.Push(Core.String, res.ToString()); 34 | }); 35 | 36 | BindMethod("reverse", ["in"], (vm, stack, target, arity, loc) => 37 | { 38 | var s = stack.Pop().Cast(Core.String, loc); 39 | char[] cs = s.ToCharArray(); 40 | Array.Reverse(cs); 41 | stack.Push(Core.String, new string(cs)); 42 | }); 43 | 44 | BindMethod("replace", ["in", "old", "new"], (vm, stack, target, arity, loc) => 45 | { 46 | var n = Stringify(stack.Pop(), loc); 47 | var o = Stringify(stack.Pop(), loc); 48 | stack.Push(Core.String, Regex.Replace(stack.Pop().Cast(Core.String), o, n)); 49 | }); 50 | 51 | BindMethod("split", ["in", "sep"], (vm, stack, target, arity, loc) => 52 | { 53 | var sep = Stringify(stack.Pop(), loc); 54 | 55 | var res = new Regex(sep). 56 | Split(Stringify(stack.Pop(), loc)). 57 | Select(s => Value.Make(Core.String, s)). 58 | ToArray(); 59 | 60 | stack.Push(Core.Array, res); 61 | }); 62 | 63 | BindMethod("up", ["in"], (vm, stack, target, arity, loc) => 64 | { 65 | var s = stack.Pop().Cast(Core.String, loc); 66 | stack.Push(Core.String, s.ToUpper()); 67 | }); 68 | } 69 | 70 | protected override void OnInit(VM vm) 71 | { 72 | Import(vm.CoreLib); 73 | 74 | vm.Eval(""" 75 | (^strip [in it] 76 | (replace in it "")) 77 | 78 | (^trim [in] 79 | (strip in "\s*")) 80 | """); 81 | } 82 | } -------------------------------------------------------------------------------- /src/Sharpl/List.cs: -------------------------------------------------------------------------------- 1 | using System.Diagnostics.CodeAnalysis; 2 | using System.Text; 3 | 4 | namespace Sharpl; 5 | 6 | public static class List 7 | { 8 | public static void Drop(this List items, int n) => items.RemoveRange(items.Count - n, n); 9 | 10 | public static T Peek(this List items, int offset = 0) => items[items.Count - 1 - offset]; 11 | 12 | public static T Pop(this List items) 13 | { 14 | var i = items.Count - 1; 15 | var v = items[i]; 16 | items.RemoveAt(i); 17 | return v; 18 | } 19 | 20 | public static void Push(this List items, T it) => items.Add(it); 21 | 22 | public static void Push(this Stack items, Type type, T data) where T : notnull => 23 | items.Push(Value.Make(type, data)); 24 | 25 | public static void Reverse(this Stack items, int n) => items.Reverse(items.Count - n, n); 26 | 27 | public static string ToString(List items) 28 | { 29 | if (items is null) { return ""; } 30 | var res = new StringBuilder(); 31 | res.Append('['); 32 | 33 | for (var i = 0; i < items.Count; i++) 34 | { 35 | if (i > 0) { res.Append(' '); } 36 | var v = items[i]; 37 | if (v is not null) { res.Append(v.ToString()); } 38 | } 39 | 40 | res.Append(']'); 41 | return res.ToString(); 42 | } 43 | 44 | public static bool TryPeek(this List items, [MaybeNullWhen(false)] out T? value) 45 | { 46 | if (items.Count > 0) 47 | { 48 | var i = items.Count - 1; 49 | value = items[i]; 50 | return true; 51 | } 52 | 53 | value = default; 54 | return false; 55 | } 56 | 57 | public static bool TryPop(this List items, [MaybeNullWhen(false)] out T? value) 58 | { 59 | if (items.Count > 0) 60 | { 61 | var i = items.Count - 1; 62 | value = items[i]; 63 | items.RemoveAt(i); 64 | return true; 65 | } 66 | 67 | value = default; 68 | return false; 69 | } 70 | 71 | public static void Trunc(this List items, int n) => 72 | items.RemoveRange(n, items.Count - n); 73 | } -------------------------------------------------------------------------------- /src/Sharpl/Loc.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public struct Loc: IComparable 4 | { 5 | public int Column; 6 | public int Line; 7 | public readonly string Source; 8 | 9 | public Loc(string source, int line = 1, int column = 1) 10 | { 11 | Source = source; 12 | Line = line; 13 | Column = column; 14 | } 15 | 16 | public void NewLine() 17 | { 18 | Line++; 19 | Column = 1; 20 | } 21 | 22 | public override string ToString() => 23 | $"{Source}@{Line}:{Column}"; 24 | 25 | public int CompareTo(Loc other) 26 | { 27 | var s = Source.CompareTo(other.Source); 28 | if (s != 0) return s; 29 | var l = Line.CompareTo(other.Line); 30 | if (l != 0) return l; 31 | return Column.CompareTo(other.Column); 32 | } 33 | } -------------------------------------------------------------------------------- /src/Sharpl/Macro.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public readonly struct Macro 4 | { 5 | public delegate void BodyType(VM vm, Macro target, Form.Queue args, Loc loc); 6 | 7 | public readonly string[] Args; 8 | public readonly BodyType Body; 9 | public readonly int MinArgCount; 10 | public readonly string Name; 11 | 12 | public Macro(string name, string[] args, BodyType body) 13 | { 14 | Name = name; 15 | Args = args; 16 | MinArgCount = args.Count((a) => !a.EndsWith('?')); 17 | Body = body; 18 | } 19 | 20 | public void Emit(VM vm, Form.Queue args, Loc loc) 21 | { 22 | if (args.Count < MinArgCount) { throw new EmitError($"Not enough arguments: {this}", loc); } 23 | Body(vm, this, args, loc); 24 | } 25 | 26 | public override string ToString() => 27 | $"({Name} [{string.Join(' ', Args)}])"; 28 | } -------------------------------------------------------------------------------- /src/Sharpl/Method.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public readonly struct Method 4 | { 5 | public delegate void BodyType(VM vm, Stack stack, Method target, int arity, Loc loc); 6 | 7 | public readonly string[] Args; 8 | public readonly BodyType Body; 9 | public readonly string Name; 10 | public readonly int MinArgCount; 11 | 12 | public Method(string name, string[] args, BodyType body) 13 | { 14 | Name = name; 15 | Args = args; 16 | MinArgCount = args.Count((a) => !a.EndsWith('?')); 17 | Body = body; 18 | 19 | } 20 | 21 | public void Call(VM vm, Stack stack, int arity, Loc loc) 22 | { 23 | if (arity < MinArgCount) { throw new EvalError($"Not enough arguments: {this}", loc); } 24 | Body(vm, stack, this, arity, loc); 25 | } 26 | 27 | public override string ToString() => 28 | $"(^{Name} [{string.Join(' ', Args)}])"; 29 | } -------------------------------------------------------------------------------- /src/Sharpl/Net/StreamPort.cs: -------------------------------------------------------------------------------- 1 | using System.Net; 2 | using System.Net.Sockets; 3 | using System.Text; 4 | 5 | namespace Sharpl.Net; 6 | 7 | public record class StreamPort(NetworkStream stream) : Port 8 | { 9 | public void Close() => stream.Close(); 10 | 11 | public async Task Read(int size) 12 | { 13 | var buffer = new byte[size]; 14 | await stream.ReadExactlyAsync(buffer); 15 | return buffer; 16 | } 17 | 18 | public Task Poll(CancellationToken ct) => 19 | Task.Run(() => stream.Socket.Poll(0, SelectMode.SelectRead)); 20 | 21 | public async Task ReadSize() => 22 | (ushort)IPAddress.NetworkToHostOrder(BitConverter.ToInt16(await Read(sizeof(ushort)))); 23 | 24 | public async Task Read(VM vm, Loc loc) 25 | { 26 | var size = await ReadSize(); 27 | var data = Encoding.UTF8.GetString(await Read(size)); 28 | var jsLoc = new Loc("json"); 29 | if (Json.ReadValue(vm, new StringReader(data), ref jsLoc) is Value v) { return v; } 30 | throw new EvalError("Failed to parse JSON value", loc); 31 | } 32 | 33 | public async Task Write(Value value, VM vm, Loc loc) 34 | { 35 | var js = value.ToJson(loc); 36 | var bs = Encoding.UTF8.GetBytes(js); 37 | var sbs = BitConverter.GetBytes(IPAddress.HostToNetworkOrder((short)bs.Length)); 38 | await stream.WriteAsync(sbs); 39 | await stream.WriteAsync(bs); 40 | } 41 | } -------------------------------------------------------------------------------- /src/Sharpl/Op.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public enum OpCode 4 | { 5 | And, 6 | BeginFrame, Benchmark, Branch, 7 | CallDirect, CallMethod, CallRegister, CallStack, CallTail, CallUserMethod, 8 | Check, CopyRegister, 9 | CreateArray, CreateIter, CreateList, CreateMap, CreatePair, 10 | Decrement, Drop, 11 | EndFrame, ExitMethod, 12 | GetRegister, Goto, 13 | Increment, IterNext, 14 | OpenInputStream, Or, 15 | PopItem, PrepareClosure, Push, PushItem, PushSplat, 16 | Repush, 17 | SetArrayItem, SetLoadPath, SetMapItem, SetRegister, Splat, Stop, Swap, 18 | Try, 19 | UnquoteRegister, Unzip 20 | }; 21 | 22 | public interface Op 23 | { 24 | OpCode Code { get; } 25 | string Dump(VM vm); 26 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/And.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class And: Op 4 | { 5 | public static Op Make(Label done) => new And(done); 6 | public readonly Label Done; 7 | 8 | public And(Label done) 9 | { 10 | Done = done; 11 | } 12 | 13 | public OpCode Code => OpCode.And; 14 | public string Dump(VM vm) => $"And {Done}"; 15 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/BeginFrame.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class BeginFrame : Op 4 | { 5 | public static Op Make(int registerCount) => new BeginFrame(registerCount); 6 | public readonly int RegisterCount; 7 | 8 | public BeginFrame(int registerCount) 9 | { 10 | RegisterCount = registerCount; 11 | } 12 | 13 | public OpCode Code => OpCode.BeginFrame; 14 | public string Dump(VM vm) => $"BeginFrame {RegisterCount}"; 15 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Benchmark.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Benchmark : Op 4 | { 5 | public static Op Make(int reps) => new Benchmark(reps); 6 | public readonly int Reps; 7 | 8 | public Benchmark(int reps) 9 | { 10 | Reps = reps; 11 | } 12 | 13 | public OpCode Code => OpCode.Benchmark; 14 | public string Dump(VM vm) => $"Benchmark {Reps}"; 15 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Branch.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Branch : Op 4 | { 5 | public static Op Make(Label right, bool pop, Loc loc) => new Branch(right, pop, loc); 6 | public readonly Label Right; 7 | public readonly bool Pop; 8 | public readonly Loc Loc; 9 | 10 | public Branch(Label right, bool pop, Loc loc) 11 | { 12 | Right = right; 13 | Pop = pop; 14 | Loc = loc; 15 | } 16 | 17 | public OpCode Code => OpCode.Branch; 18 | public string Dump(VM vm) => $"Branch {Right} {Pop} {Loc}"; 19 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CallDirect.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CallDirect : Op 4 | { 5 | public static Op Make(Value Target, int arity, bool splat, int registerCount, Loc loc) => 6 | new CallDirect(Target, arity, splat, registerCount, loc); 7 | 8 | public readonly Loc Loc; 9 | public readonly Value Target; 10 | public readonly int Arity; 11 | public readonly bool Splat; 12 | public readonly int RegisterCount; 13 | 14 | public CallDirect(Value target, int arity, bool splat, int registerCount, Loc loc) 15 | { 16 | Target = target; 17 | Arity = arity; 18 | Splat = splat; 19 | RegisterCount = registerCount; 20 | Loc = loc; 21 | } 22 | 23 | public OpCode Code => OpCode.CallDirect; 24 | 25 | public string Dump(VM vm) => 26 | $"CallDirect {Loc} {Target} {Arity} {Splat} {RegisterCount}"; 27 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CallMethod.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CallMethod : Op 4 | { 5 | public static Op Make(Method target, int arity, bool splat, Loc loc) => 6 | new CallMethod(target, arity, splat, loc); 7 | 8 | public readonly Loc Loc; 9 | public readonly Method Target; 10 | public readonly int Arity; 11 | public readonly bool Splat; 12 | 13 | public CallMethod(Method target, int arity, bool splat, Loc loc) 14 | { 15 | Loc = loc; 16 | Target = target; 17 | Arity = arity; 18 | Splat = splat; 19 | } 20 | 21 | public OpCode Code => OpCode.CallMethod; 22 | public string Dump(VM vm) => $"CallMethod {Target} {Arity} {Splat}"; 23 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CallRegister.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CallRegister : Op 4 | { 5 | public static Op Make(Register target, int arity, bool splat, int registerCount, Loc loc) => 6 | new CallRegister(target, arity, splat, registerCount, loc); 7 | 8 | public readonly Loc Loc; 9 | public readonly Register Target; 10 | public readonly int Arity; 11 | public readonly bool Splat; 12 | public readonly int RegisterCount; 13 | 14 | public CallRegister(Register target, int arity, bool splat, int registerCount, Loc loc) 15 | { 16 | Target = target; 17 | Arity = arity; 18 | Splat = splat; 19 | RegisterCount = registerCount; 20 | Loc = loc; 21 | } 22 | 23 | public OpCode Code => OpCode.CallRegister; 24 | public string Dump(VM vm) => $"CallRegister {Loc} {Target} {Arity} {Splat} {RegisterCount}"; 25 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CallStack.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CallStack : Op 4 | { 5 | public static Op Make(int arity, bool splat, int registerCount, Loc loc) => 6 | new CallStack(arity, splat, registerCount, loc); 7 | 8 | public readonly int Arity; 9 | public readonly bool Splat; 10 | public readonly int RegisterCount; 11 | public readonly Loc Loc; 12 | 13 | public CallStack(int arity, bool splat, int registerCount, Loc loc) 14 | { 15 | Arity = arity; 16 | Splat = splat; 17 | RegisterCount = registerCount; 18 | Loc = loc; 19 | } 20 | 21 | public OpCode Code => OpCode.CallStack; 22 | public string Dump(VM vm) => $"CallStack {Loc} {Arity} {Splat} {RegisterCount}"; 23 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CallTail.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CallTail : Op 4 | { 5 | public static Op Make(UserMethod target, Value?[] argMask, bool splat, Loc loc) => 6 | new CallTail(target, argMask, splat, loc); 7 | 8 | public readonly UserMethod Target; 9 | public readonly Value?[] ArgMask; 10 | public readonly bool Splat; 11 | public readonly Loc Loc; 12 | 13 | public CallTail(UserMethod target, Value?[] argMask, bool splat, Loc loc) 14 | { 15 | Target = target; 16 | ArgMask = argMask; 17 | Splat = splat; 18 | Loc = loc; 19 | } 20 | public OpCode Code => OpCode.CallTail; 21 | public string Dump(VM vm) => $"CallTail {Loc} {Target} {ArgMask} {Splat}"; 22 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CallUserMethod.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CallUserMethod : Op 4 | { 5 | public static Op Make(UserMethod Target, Value?[] argMask, bool splat, int registerCount, Loc loc) => 6 | new CallUserMethod(Target, argMask, splat, registerCount, loc); 7 | 8 | public readonly UserMethod Target; 9 | public readonly Value?[] ArgMask; 10 | public readonly bool Splat; 11 | public readonly int RegisterCount; 12 | public readonly Loc Loc; 13 | 14 | public CallUserMethod(UserMethod target, Value?[] argMask, bool splat, int registerCount, Loc loc) 15 | { 16 | Target = target; 17 | ArgMask = argMask; 18 | Splat = splat; 19 | RegisterCount = registerCount; 20 | Loc = loc; 21 | } 22 | 23 | public OpCode Code => OpCode.CallUserMethod; 24 | public string Dump(VM vm) => $"CallUserMethod {Target} {ArgMask} {Splat} {RegisterCount}"; 25 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Check.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Check : Op 4 | { 5 | public static Op Make(Loc loc) => new Check(loc); 6 | public readonly Loc Loc; 7 | 8 | public Check(Loc loc) 9 | { 10 | Loc = loc; 11 | } 12 | 13 | public OpCode Code => OpCode.Check; 14 | public string Dump(VM vm) => $"Check {Loc}"; 15 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CopyRegister.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CopyRegister : Op 4 | { 5 | public static Op Make(Register from, Register to) => new CopyRegister(from, to); 6 | 7 | public readonly Register From; 8 | public readonly Register To; 9 | 10 | public CopyRegister(Register from, Register to) 11 | { 12 | From = from; 13 | To = to; 14 | } 15 | 16 | public OpCode Code => OpCode.CopyRegister; 17 | public string Dump(VM vm) => $"CopyRegister {From} {To}"; 18 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CreateArray.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CreateArray : Op 4 | { 5 | public static Op Make(int length) => new CreateArray(length); 6 | public readonly int Length; 7 | public CreateArray(int length) 8 | { 9 | Length = length; 10 | } 11 | 12 | public OpCode Code => OpCode.CreateArray; 13 | public string Dump(VM vm) => $"CreateArray {Length}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CreateIter.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CreateIter : Op 4 | { 5 | public static Op Make(Register target, Loc loc) => new CreateIter(target, loc); 6 | public readonly Register Target; 7 | public readonly Loc Loc; 8 | public CreateIter(Register target, Loc loc) 9 | { 10 | Target = target; 11 | Loc = loc; 12 | } 13 | 14 | public OpCode Code => OpCode.CreateIter; 15 | public string Dump(VM vm) => $"CreateIter {Loc} {Target}"; 16 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CreateList.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CreateList : Op 4 | { 5 | public static Op Make(Register target) => new CreateList(target); 6 | public readonly Register Target; 7 | public CreateList(Register target) 8 | { 9 | Target = target; 10 | } 11 | 12 | public OpCode Code => OpCode.CreateList; 13 | public string Dump(VM vm) => $"CreateList {Target}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CreateMap.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CreateMap : Op 4 | { 5 | public static Op Make(int length) => new CreateMap(length); 6 | public readonly int Length; 7 | 8 | public CreateMap(int length) 9 | { 10 | Length = length; 11 | } 12 | 13 | public OpCode Code => OpCode.CreateMap; 14 | public string Dump(VM vm) => $"CreateMap {Length}"; 15 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/CreatePair.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class CreatePair : Op 4 | { 5 | public static Op Make(Loc loc) => new CreatePair(loc); 6 | public readonly Loc Loc; 7 | public CreatePair(Loc loc) 8 | { 9 | Loc = loc; 10 | } 11 | 12 | public OpCode Code => OpCode.CreatePair; 13 | public string Dump(VM vm) => $"CreatePair {Loc}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Decrement.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Decrement : Op 4 | { 5 | public static Op Make(Register target, int delta) => new Decrement(target, delta); 6 | public readonly Register Target; 7 | public readonly int Delta; 8 | 9 | public Decrement(Register target, int delta) 10 | { 11 | Target = target; 12 | Delta = delta; 13 | } 14 | 15 | public OpCode Code => OpCode.Decrement; 16 | 17 | public string Dump(VM vm) => $"Decrement {Target} {Delta}"; 18 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Drop.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Drop : Op 4 | { 5 | public static Op Make(int count) => new Drop(count); 6 | public readonly int Count; 7 | public Drop(int count) { Count = count; } 8 | public OpCode Code => OpCode.Drop; 9 | public string Dump(VM vm) => $"Drop {Count}"; 10 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/EndFrame.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class EndFrame : Op 4 | { 5 | public readonly Loc Loc; 6 | public static Op Make(Loc loc) => new EndFrame(loc); 7 | public EndFrame(Loc loc) { Loc = loc; } 8 | public OpCode Code => OpCode.EndFrame; 9 | public string Dump(VM vm) => "EndFrame"; 10 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/ExitMethod.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | public class ExitMethod : Op 3 | { 4 | public static Op Instance = new ExitMethod(); 5 | public static Op Make() => Instance; 6 | public ExitMethod() { } 7 | public OpCode Code => OpCode.ExitMethod; 8 | public string Dump(VM vm) => $"ExitMethod"; 9 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/GetRegister.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class GetRegister : Op 4 | { 5 | public static Op Make(Register target) => new GetRegister(target); 6 | public readonly Register Target; 7 | public GetRegister(Register target) 8 | { 9 | Target = target; 10 | } 11 | 12 | public OpCode Code => OpCode.GetRegister; 13 | public string Dump(VM vm) => $"GetRegister {Target}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Goto.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Goto : Op 4 | { 5 | public static Op Make(Label target) => new Goto(target); 6 | public readonly Label Target; 7 | public Goto(Label target) 8 | { 9 | Target = target; 10 | } 11 | 12 | public OpCode Code => OpCode.Goto; 13 | public string Dump(VM vm) => $"Goto {Target}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Increment.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Increment : Op 4 | { 5 | public static Op Make(Register target, int delta) => new Increment(target, delta); 6 | public readonly Register Target; 7 | public readonly int Delta; 8 | public Increment(Register target, int delta) 9 | { 10 | Target = target; 11 | Delta = delta; 12 | } 13 | 14 | public OpCode Code => OpCode.Increment; 15 | public string Dump(VM vm) => $"Increment {Target} {Delta}"; 16 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/IterNext.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class IterNext : Op 4 | { 5 | public static Op Make(Register iter, Label done, bool push, Loc loc) => 6 | new IterNext(iter, done, push, loc); 7 | 8 | public readonly Register Iter; 9 | public readonly Label Done; 10 | public readonly bool Push; 11 | public readonly Loc Loc; 12 | 13 | public IterNext(Register iter, Label done, bool push, Loc loc) 14 | { 15 | Iter = iter; 16 | Done = done; 17 | Push = push; 18 | Loc = loc; 19 | } 20 | 21 | public OpCode Code => OpCode.IterNext; 22 | public string Dump(VM vm) => $"IterNext {Loc} {Iter} {Done} {Push}"; 23 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/OpenInputStream.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class OpenInputStream : Op 4 | { 5 | public static Op Make(int frameOffset, int index, Loc loc) => 6 | new OpenInputStream(frameOffset, index, loc); 7 | 8 | public readonly int FrameOffset; 9 | public readonly int Index; 10 | public readonly Loc Loc; 11 | 12 | public OpenInputStream(int frameOffset, int index, Loc loc) 13 | { 14 | FrameOffset = frameOffset; 15 | Index = index; 16 | Loc = loc; 17 | } 18 | 19 | public OpCode Code => OpCode.OpenInputStream; 20 | public string Dump(VM vm) => $"OpenInputStream {Loc} {FrameOffset}:{Index}"; 21 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Or.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Or : Op 4 | { 5 | public static Op Make(Label done) => new Or(done); 6 | public readonly Label Done; 7 | public Or(Label done) 8 | { 9 | Done = done; 10 | } 11 | 12 | public OpCode Code => OpCode.Or; 13 | public string Dump(VM vm) => $"Or {Done}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/PopItem.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class PopItem : Op 4 | { 5 | public static Op Make(Register target, Loc loc) => new PopItem(target, loc); 6 | public readonly Register Target; 7 | public readonly Loc Loc; 8 | public PopItem(Register target, Loc loc) 9 | { 10 | Target = target; 11 | Loc = loc; 12 | } 13 | 14 | public OpCode Code => OpCode.PopItem; 15 | public string Dump(VM vm) => $"PopItem {Loc} {Target}"; 16 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/PrepareClosure.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class PrepareClosure : Op 4 | { 5 | public static Op Make(UserMethod target, Label skip) => new PrepareClosure(target, skip); 6 | public readonly UserMethod Target; 7 | public readonly Label Skip; 8 | public PrepareClosure(UserMethod target, Label skip) 9 | { 10 | Target = target; 11 | Skip = skip; 12 | } 13 | 14 | public OpCode Code => OpCode.PrepareClosure; 15 | public string Dump(VM vm) => $"PrepareClosure {Target} {Skip}"; 16 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Push.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Push : Op 4 | { 5 | public static Op Make(Value value) => new Push(value); 6 | public readonly Value Value; 7 | public Push(Value value) 8 | { 9 | Value = value; 10 | } 11 | 12 | public OpCode Code => OpCode.Push; 13 | public string Dump(VM vm) => $"Push {Value}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/PushItem.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class PushItem : Op 4 | { 5 | public static Op Make(Register target, Loc loc) => new PushItem(target, loc); 6 | public readonly Register Target; 7 | public readonly Loc Loc; 8 | public PushItem(Register target, Loc loc) 9 | { 10 | Target = target; 11 | Loc = loc; 12 | } 13 | 14 | public OpCode Code => OpCode.PushItem; 15 | public string Dump(VM vm) => $"PushItem {Loc} {Target}"; 16 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/PushSplat.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | public class PushSplat : Op 3 | { 4 | public static Op Make() => new PushSplat(); 5 | public PushSplat() { } 6 | public OpCode Code => OpCode.PushSplat; 7 | public string Dump(VM vm) => "PushSplat"; 8 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Repush.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | public class Repush : Op 3 | { 4 | public static Op Make(int count) => new Repush(count); 5 | public readonly int Count; 6 | public Repush(int count) 7 | { 8 | Count = count; 9 | } 10 | 11 | public OpCode Code => OpCode.Repush; 12 | public string Dump(VM vm) => $"Repush {Count}"; 13 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/SetArrayItem.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class SetArrayItem : Op 4 | { 5 | public static Op Make(int index) => new SetArrayItem(index); 6 | public readonly int Index; 7 | public SetArrayItem(int index) 8 | { 9 | Index = index; 10 | } 11 | 12 | public OpCode Code => OpCode.SetArrayItem; 13 | public string Dump(VM vm) => $"SetArrayItem {Index}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/SetLoadPath.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class SetLoadPath : Op 4 | { 5 | public static Op Make(string path) => new SetLoadPath(path); 6 | public readonly string Path; 7 | public SetLoadPath(string path) 8 | { 9 | Path = path; 10 | } 11 | 12 | public OpCode Code => OpCode.SetLoadPath; 13 | public string Dump(VM vm) => $"SetLoadPath {Path}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/SetMapItem.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class SetMapItem : Op 4 | { 5 | public static Op Make() => new SetMapItem(); 6 | public SetMapItem() { } 7 | public OpCode Code => OpCode.SetMapItem; 8 | public string Dump(VM vm) => $"SetMapItem"; 9 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/SetRegister.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class SetRegister : Op 4 | { 5 | public static Op Make(Register target) => new SetRegister(target); 6 | public readonly Register Target; 7 | public SetRegister(Register target) 8 | { 9 | Target = target; 10 | } 11 | 12 | public OpCode Code => OpCode.SetRegister; 13 | public string Dump(VM vm) => $"SetRegister {Target}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Splat.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Splat : Op 4 | { 5 | public static Op Make(Loc loc) => new Splat(loc); 6 | public readonly Loc Loc; 7 | public Splat(Loc loc) 8 | { 9 | Loc = loc; 10 | } 11 | 12 | public OpCode Code => OpCode.Splat; 13 | public string Dump(VM vm) => $"Splat {Loc}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Stop.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | public class Stop : Op 3 | { 4 | public static readonly Op Instance = new Stop(); 5 | public static Op Make() => Instance; 6 | public Stop() { } 7 | public OpCode Code => OpCode.Stop; 8 | public string Dump(VM vm) => $"Stop"; 9 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Swap.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Swap : Op 4 | { 5 | public static Op Make(Loc loc) => new Swap(loc); 6 | public readonly Loc Loc; 7 | public Swap(Loc loc) 8 | { 9 | Loc = loc; 10 | } 11 | 12 | public OpCode Code => OpCode.Swap; 13 | public string Dump(VM vm) => $"Swap {Loc}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Try.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Libs; 2 | 3 | namespace Sharpl.Ops; 4 | 5 | public class Try : Op 6 | { 7 | public static Op Make((Value, Value)[] handlers, int registerCount, Label end, Register locReg, Loc loc) => 8 | new Try(handlers, registerCount, end, locReg, loc); 9 | 10 | public readonly (Value, Value)[] Handlers; 11 | public readonly Label End; 12 | public readonly int RegisterCount; 13 | public readonly Loc Loc; 14 | public readonly Register LocReg; 15 | 16 | public Try((Value, Value)[] handlers, int registerCount, Label end, Register locReg, Loc loc) 17 | { 18 | Handlers = handlers; 19 | End = end; 20 | RegisterCount = registerCount; 21 | Loc = loc; 22 | LocReg = locReg; 23 | } 24 | 25 | public OpCode Code => OpCode.Try; 26 | public string Dump(VM vm) => $"Try {Handlers} {RegisterCount} {End} {LocReg} {Loc}"; 27 | 28 | public bool HandleError(VM vm, Value value, Stack stack, Loc loc) 29 | { 30 | var ev = value; 31 | vm.Set(LocReg, Value.Make(Core.Loc, loc)); 32 | var handled = false; 33 | 34 | foreach (var (k, v) in Handlers) 35 | { 36 | if (k == Value._ || 37 | ev.Isa(k.Type) || 38 | (k.Type == Core.Meta && ev.Isa(k.Cast(Core.Meta)))) 39 | { 40 | stack.Push(ev); 41 | vm.PC = End.PC; 42 | v.Call(vm, stack, 1, RegisterCount, false, loc); 43 | handled = true; 44 | break; 45 | } 46 | } 47 | 48 | if (!handled) { vm.PC = End.PC; } 49 | return handled; 50 | } 51 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/UnquoteRegister.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class UnquoteRegister : Op 4 | { 5 | public static Op Make(Register register, Loc loc) => new UnquoteRegister(register, loc); 6 | public readonly Register Register; 7 | public readonly Loc Loc; 8 | public UnquoteRegister(Register register, Loc loc) 9 | { 10 | Register = register; 11 | Loc = loc; 12 | } 13 | 14 | public OpCode Code => OpCode.UnquoteRegister; 15 | public string Dump(VM vm) => $"UnquoteRegister {Loc} {Register}"; 16 | } -------------------------------------------------------------------------------- /src/Sharpl/Ops/Unzip.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Ops; 2 | 3 | public class Unzip : Op 4 | { 5 | public static Op Make(Loc loc) => new Unzip(loc); 6 | public readonly Loc Loc; 7 | public Unzip(Loc loc) 8 | { 9 | Loc = loc; 10 | } 11 | 12 | public OpCode Code => OpCode.Unzip; 13 | public string Dump(VM vm) => $"Unzip {Loc}"; 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Order.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public enum Order 4 | { 5 | LT = -1, 6 | EQ = 0, 7 | GT = 1 8 | }; -------------------------------------------------------------------------------- /src/Sharpl/OrderedMap.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public class OrderedMap where K : IComparable 4 | { 5 | private readonly List<(K, V)> items; 6 | 7 | public OrderedMap((K, V)[] items) 8 | { 9 | this.items = new List<(K, V)>(items); 10 | } 11 | 12 | public OrderedMap() : this([]) { } 13 | 14 | public V? this[K key] 15 | { 16 | get => Get(key); 17 | set => Set(key, value); 18 | } 19 | 20 | public bool ContainsKey(K key) 21 | { 22 | var (_, ok) = Find(key); 23 | return ok; 24 | } 25 | 26 | public int Count { get => items.Count; } 27 | 28 | public void Delete(int i) => items.RemoveAt(i); 29 | 30 | public (int, bool) Find(K key) 31 | { 32 | var min = 0; 33 | var max = items.Count; 34 | 35 | while (min < max) 36 | { 37 | var i = (min + max) / 2; 38 | var it = items[i]; 39 | var cres = key.CompareTo(it.Item1); 40 | if (cres < 0) { max = i; } 41 | else if (cres > 0) { min = i + 1; } 42 | else { return (i, true); } 43 | } 44 | 45 | return (max, false); 46 | } 47 | 48 | public V? Get(K key) 49 | { 50 | var (i, ok) = Find(key); 51 | return ok ? items[i].Item2 : default; 52 | } 53 | 54 | public IEnumerator<(K, V)> GetEnumerator() => items.AsEnumerable().GetEnumerator(); 55 | 56 | public int IndexOf(K key) 57 | { 58 | var (i, ok) = Find(key); 59 | return ok ? i : -1; 60 | } 61 | 62 | public void Insert(int i, K key, V value) => items.Insert(i, (key, value)); 63 | public (K, V)[] Items => items.ToArray(); 64 | 65 | public V? Remove(K key) 66 | { 67 | var (i, ok) = Find(key); 68 | if (!ok) { return default; } 69 | var v = items[i].Item2; 70 | Delete(i); 71 | return v; 72 | } 73 | 74 | public V? Set(K key, V? value) 75 | { 76 | var (i, ok) = Find(key); 77 | 78 | if (value is V v) 79 | { 80 | if (ok) 81 | { 82 | var pv = items[i].Item2; 83 | items[i] = (key, value); 84 | return pv; 85 | } 86 | 87 | Insert(i, key, v); 88 | return default; 89 | } 90 | 91 | if (ok) 92 | { 93 | var pv = items[i].Item2; 94 | Delete(i); 95 | return pv; 96 | } 97 | 98 | return default; 99 | } 100 | } -------------------------------------------------------------------------------- /src/Sharpl/PipePort.cs: -------------------------------------------------------------------------------- 1 | using System.Threading.Channels; 2 | 3 | namespace Sharpl; 4 | 5 | public record class PipePort(ChannelReader Reader, ChannelWriter Writer) : Port 6 | { 7 | public void Close() { } 8 | public async Task Poll(CancellationToken ct) => await Reader.WaitToReadAsync(ct); 9 | public async Task Read(VM vm, Loc loc) => await Reader.ReadAsync(); 10 | public async Task Write(Value value, VM vm, Loc loc) => await Writer.WriteAsync(value); 11 | } -------------------------------------------------------------------------------- /src/Sharpl/Port.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public interface Port 4 | { 5 | void Close(); 6 | Task Poll(CancellationToken ct); 7 | Task Read(VM vm, Loc loc); 8 | Task Write(Value value, VM vm, Loc loc); 9 | } -------------------------------------------------------------------------------- /src/Sharpl/REPL.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl; 4 | 5 | public class REPL 6 | { 7 | private List<(Sym, Value)> restarts = new List<(Sym, Value)>(); 8 | 9 | public void Run(VM vm) 10 | { 11 | vm.Term 12 | .Write($"sharpl v{VM.VERSION}\n\n") 13 | .Reset(); 14 | 15 | var buffer = new StringBuilder(); 16 | var loc = new Loc("repl"); 17 | var bufferLines = 0; 18 | var stack = new Stack(); 19 | 20 | while (true) 21 | { 22 | vm.Term 23 | .Write($"{loc.Line + bufferLines,4} ") 24 | .Reset() 25 | .Flush(); 26 | 27 | var line = Console.In.ReadLine(); 28 | if (line is null) { break; } 29 | 30 | if (line == "") 31 | { 32 | try 33 | { 34 | var v = Eval(vm, buffer.ToString(), stack, ref loc); 35 | vm.Term.WriteLine(v.Dump(vm)); 36 | } 37 | catch (Exception e) 38 | { 39 | vm.Term.WriteLine(e); 40 | } 41 | finally 42 | { 43 | buffer.Clear(); 44 | bufferLines = 0; 45 | } 46 | 47 | vm.Term.Write("\n"); 48 | } 49 | else 50 | { 51 | buffer.Append(line); 52 | buffer.AppendLine(); 53 | bufferLines++; 54 | } 55 | } 56 | } 57 | 58 | public virtual Value Eval(VM vm, string input, Stack stack, ref Loc loc) 59 | { 60 | var startPC = vm.EmitPC; 61 | var fs = vm.ReadForms(new Source(new StringReader(input)), ref loc); 62 | var _loc = loc; 63 | 64 | vm.DoEnv(vm.Env, loc, () => 65 | { 66 | vm.Env.Bind("LOC", Value.Make(Libs.Core.Binding, vm.CoreLib.LOC)); 67 | var end = new Label(); 68 | vm.Emit(Ops.Try.Make(vm.Restarts, vm.NextRegisterIndex, end, vm.CoreLib.LOC, _loc)); 69 | fs.Emit(vm); 70 | vm.Emit(Ops.EndFrame.Make(_loc)); 71 | end.PC = vm.EmitPC; 72 | vm.Emit(Ops.Stop.Make()); 73 | }); 74 | 75 | Value result = Value._; 76 | 77 | try 78 | { 79 | vm.Eval(startPC, stack); 80 | if (stack.TryPop(out var rv)) result = rv; 81 | } 82 | catch (EvalError e) 83 | { 84 | vm.Term.WriteLine(e); 85 | e.AddRestarts(vm); 86 | vm.AddRestart(vm.Intern("stop"), 0, (vm, stack, target, arity, loc) => { vm.PC = vm.EmitPC - 1; }); 87 | var rs = vm.Restarts; 88 | for (var i = 0; i < rs.Length; i++) { vm.Term.WriteLine($"{i + 1} {rs[i].Item1.Cast(Libs.Core.Sym).Name}"); } 89 | var n = int.Parse((string)vm.Term.Ask(vm, $"Pick an alternative (1-{rs.Length}) and press ⏎: ")!); 90 | rs[n-1].Item2.Call(vm, stack, 0, vm.NextRegisterIndex, false, loc); 91 | if (stack.TryPop(out var rv)) result = rv; 92 | } 93 | 94 | return result; 95 | } 96 | } -------------------------------------------------------------------------------- /src/Sharpl/Reader.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public readonly record struct Source(TextReader Reader) 4 | { 5 | public static char? ToChar(int c) => (c == -1) ? null : Convert.ToChar(c); 6 | public char? Peek() => (buffer.Count == 0) ? ToChar(Reader.Peek()) : buffer.Peek(); 7 | public char? Read() => (buffer.Count == 0) ? ToChar(Reader.Read()) : buffer.Pop(); 8 | public void Unread(char c) => buffer.Push(c); 9 | private readonly List buffer = new List(); 10 | } 11 | 12 | public interface Reader 13 | { 14 | bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc); 15 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/And.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct And : Reader 4 | { 5 | public static readonly And Instance = new And(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | if (forms.Count == 0) { return false; } 10 | var c = source.Peek(); 11 | if (c is null || c != '&') { return false; } 12 | var left = forms.PopLast(); 13 | var formLoc = left.Loc; 14 | loc.Column++; 15 | source.Read(); 16 | if (!vm.ReadForm(source, ref loc, forms)) { throw new ReadError("Missing right value", loc); } 17 | WhiteSpace.Instance.Read(source, vm, forms, ref loc); 18 | if (source.Peek() == '&' && !Read(source, vm, forms, ref loc)) { throw new ReadError("Failed reading nested and form", loc); } 19 | var right = forms.PopLast(); 20 | forms.Push(new Forms.And(left, right, formLoc)); 21 | return true; 22 | } 23 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Array.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct Array : Reader 4 | { 5 | public static readonly Array Instance = new Array(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | var c = source.Peek(); 10 | if (c == -1 || c != '[') { return false; } 11 | var formLoc = loc; 12 | loc.Column++; 13 | source.Read(); 14 | 15 | var items = new Form.Queue(); 16 | 17 | while (true) 18 | { 19 | WhiteSpace.Instance.Read(source, vm, forms, ref loc); 20 | c = source.Peek(); 21 | if (c is null) { throw new ReadError("Unexpected end of array", loc); } 22 | 23 | if (c == ']') 24 | { 25 | loc.Column++; 26 | source.Read(); 27 | break; 28 | } 29 | 30 | if (!vm.ReadForm(source, ref loc, items)) { throw new ReadError("Unexpected end of array", loc); } 31 | } 32 | 33 | forms.Push(new Forms.Array(items.Items, formLoc)); 34 | return true; 35 | } 36 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Call.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct Call : Reader 4 | { 5 | public static readonly Call Instance = new Call(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | var c = source.Peek(); 10 | if (c is null || c != '(') { return false; } 11 | 12 | var formLoc = loc; 13 | loc.Column++; 14 | source.Read(); 15 | var args = new Form.Queue(); 16 | 17 | while (true) 18 | { 19 | WhiteSpace.Instance.Read(source, vm, args, ref loc); 20 | c = source.Peek(); 21 | 22 | if (c is null) { throw new ReadError("Unexpected end of call", loc); } 23 | 24 | if (c == ')') 25 | { 26 | loc.Column++; 27 | source.Read(); 28 | break; 29 | } 30 | 31 | if (!vm.ReadForm(source, ref loc, args)) { throw new ReadError("Unexpected end of call " + forms, loc); } 32 | } 33 | 34 | if (args.Empty) { throw new ReadError("Missing call target", loc); } 35 | var target = args.Pop(); 36 | forms.Push(new Forms.Call((Form)target, args.Items, formLoc)); 37 | return true; 38 | } 39 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Char.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Libs; 2 | 3 | namespace Sharpl.Readers; 4 | 5 | public struct Char : Reader 6 | { 7 | public static readonly Char Instance = new Char(); 8 | 9 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 10 | { 11 | var c = source.Peek(); 12 | if (c is null || c != '\\') { return false; } 13 | var formLoc = loc; 14 | source.Read(); 15 | loc.Column++; 16 | 17 | c = source.Read(); 18 | if (c is null) { throw new ReadError("Invalid char literal", loc); } 19 | 20 | if (c == '\\') 21 | { 22 | c = source.Read() switch 23 | { 24 | 'n' => '\n', 25 | 'r' => '\r', 26 | 's' => ' ', 27 | var e => throw new ReadError($"Invalid special char literal: {e}", loc) 28 | }; 29 | } 30 | 31 | forms.Push(new Forms.Literal(Value.Make(Core.Char, (char)c), formLoc)); 32 | return true; 33 | } 34 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Fix.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Libs; 2 | using System.Globalization; 3 | 4 | namespace Sharpl.Readers; 5 | 6 | public struct Fix : Reader 7 | { 8 | public static readonly Fix Instance = new Fix(); 9 | 10 | public bool Read(Source source, VM vm, ref Loc loc, Form.Queue forms, Loc formLoc, long val) 11 | { 12 | var c = source.Peek(); 13 | if (c is null || c != '.') { return false; } 14 | source.Read(); 15 | c = source.Peek(); 16 | 17 | if (c == '.') 18 | { 19 | source.Unread('.'); 20 | return false; 21 | } 22 | 23 | loc.Column++; 24 | byte e = 0; 25 | 26 | while (true) 27 | { 28 | c = source.Peek(); 29 | if (c is null) { break; } 30 | if (!char.IsAsciiDigit((char)c)) { break; } 31 | source.Read(); 32 | val = val * 10 + (long)CharUnicodeInfo.GetDecimalDigitValue((char)c); 33 | e++; 34 | loc.Column++; 35 | } 36 | 37 | if (formLoc.Column == loc.Column) { return false; } 38 | forms.Push(new Forms.Literal(Value.Make(Core.Fix, Sharpl.Fix.Make(e, val)), formLoc)); 39 | return true; 40 | } 41 | 42 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) => 43 | Read(source, vm, ref loc, forms, loc, 0); 44 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Id.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Readers; 4 | 5 | public struct Id : Reader 6 | { 7 | public static readonly Id Instance = new Id(); 8 | 9 | public static bool Valid(char c) => 10 | !(char.IsWhiteSpace(c) || char.IsControl(c) || 11 | c == '(' || c == ')' || 12 | c == '[' || c == ']' || 13 | c == '{' || c == '}' || 14 | c == '\'' || c == ',' || c == '.' || c == '"' || c == ':' || c == '&' || c == '#'); 15 | 16 | 17 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 18 | { 19 | var c = source.Peek(); 20 | if (c is null) { return false; } 21 | if (!Valid((char)c) || char.IsDigit((char)c)) { return false; } 22 | 23 | var formLoc = loc; 24 | var buffer = new StringBuilder(); 25 | 26 | while (true) 27 | { 28 | c = source.Peek(); 29 | if (c is null) { break; } 30 | if (!Valid((char)c) || ((c == '*') && buffer.Length != 0)) { break; } 31 | source.Read(); 32 | buffer.Append(c); 33 | loc.Column++; 34 | if (c == '^' && buffer.Length == 1) { break; } 35 | } 36 | 37 | if (buffer.Length == 0) { return false; } 38 | var s = buffer.ToString(); 39 | forms.Push(s.Equals("_") ? new Forms.Nil(loc) : new Forms.Id(buffer.ToString(), formLoc)); 40 | return true; 41 | } 42 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Int.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Libs; 2 | using System.Globalization; 3 | 4 | namespace Sharpl.Readers; 5 | 6 | public struct Int : Reader 7 | { 8 | public static readonly Int Instance = new Int(); 9 | 10 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 11 | { 12 | var formLoc = loc; 13 | var v = 0; 14 | 15 | while (true) 16 | { 17 | var c = source.Peek(); 18 | if (c is null) { break; } 19 | 20 | if (c == '.') 21 | { 22 | source.Read(); 23 | c = source.Peek(); 24 | source.Unread('.'); 25 | if (c == '.') { break; } 26 | return Fix.Instance.Read(source, vm, ref loc, forms, formLoc, v); 27 | } 28 | 29 | if (!char.IsAsciiDigit((char)c)) { break; } 30 | source.Read(); 31 | v = v * 10 + CharUnicodeInfo.GetDecimalDigitValue((char)c); 32 | loc.Column++; 33 | } 34 | 35 | if (formLoc.Column == loc.Column) { return false; } 36 | forms.Push(new Forms.Literal(Value.Make(Core.Int, v), formLoc)); 37 | return true; 38 | } 39 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Length.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct Length : Reader 4 | { 5 | public static readonly Length Instance = new Length(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | var c = source.Peek(); 10 | if (c is null || c != '#') { return false; } 11 | var formLoc = loc; 12 | loc.Column++; 13 | source.Read(); 14 | 15 | if (vm.ReadForm(source, ref loc, forms) && forms.TryPopLast() is Form f) 16 | { 17 | forms.Push(new Forms.Call(new Forms.Id("length", formLoc), [f], formLoc)); 18 | } 19 | else { throw new ReadError("Missing length value", loc); } 20 | 21 | return true; 22 | } 23 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Map.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct Map : Reader 4 | { 5 | public static readonly Map Instance = new Map(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | var c = source.Peek(); 10 | if (c is null || c != '{') { return false; } 11 | var formLoc = loc; 12 | loc.Column++; 13 | source.Read(); 14 | var items = new Form.Queue(); 15 | 16 | while (true) 17 | { 18 | WhiteSpace.Instance.Read(source, vm, forms, ref loc); 19 | c = source.Peek(); 20 | if (c is null) { throw new ReadError("Unexpected end of map", loc); } 21 | 22 | if (c == '}') 23 | { 24 | loc.Column++; 25 | source.Read(); 26 | break; 27 | } 28 | 29 | if (!vm.ReadForm(source, ref loc, items)) { throw new ReadError("Unexpected end of map", loc); } 30 | } 31 | 32 | forms.Push(new Forms.Map(items.Items, formLoc)); 33 | return true; 34 | } 35 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/OneOf.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct OneOf(Reader[] Parts) : Reader 4 | { 5 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 6 | { 7 | foreach (var r in Parts) 8 | { 9 | if (r.Read(source, vm, forms, ref loc)) { return true; } 10 | } 11 | 12 | return false; 13 | } 14 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Pair.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct Pair : Reader 4 | { 5 | public static readonly Pair Instance = new Pair(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | if (forms.Count == 0) { return false; } 10 | var c = source.Peek(); 11 | if (c is null || c != ':') { return false; } 12 | var left = forms.TryPopLast(); 13 | if (left is null) { throw new EmitError("Missing left value", loc); } 14 | var formLoc = left.Loc; 15 | loc.Column++; 16 | source.Read(); 17 | if (!vm.ReadForm(source, ref loc, forms)) { throw new ReadError("Missing right value", loc); } 18 | WhiteSpace.Instance.Read(source, vm, forms, ref loc); 19 | if (source.Peek() == ':' && !vm.ReadForm(source, ref loc, forms)) { throw new ReadError("Failed reading nested pair", loc); } 20 | var right = forms.TryPopLast(); 21 | if (right is null) { throw new ReadError("Missing right value", loc); } 22 | forms.Push(new Forms.Pair(left, right, formLoc)); 23 | return true; 24 | } 25 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Quote.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct Quote : Reader 4 | { 5 | public static readonly Quote Instance = new Quote(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | var c = source.Peek(); 10 | if (c is null || c != '\'') { return false; } 11 | var formLoc = loc; 12 | loc.Column++; 13 | source.Read(); 14 | if (vm.ReadForm(source, ref loc, forms) && forms.TryPopLast() is Form f) { forms.Push(new Forms.QuoteForm(f, formLoc)); } 15 | else { throw new ReadError("Missing quoted value", loc); } 16 | return true; 17 | } 18 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Range.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct Range : Reader 4 | { 5 | public static readonly Range Instance = new Range(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | if (forms.Empty) { return false; } 10 | var c = source.Peek(); 11 | if (c is null || c != '.') { return false; } 12 | source.Read(); 13 | c = source.Peek(); 14 | 15 | if (c != '.') 16 | { 17 | source.Unread('.'); 18 | return false; 19 | } 20 | 21 | source.Read(); 22 | var formLoc = loc; 23 | loc.Column += 2; 24 | var left = forms.PopLast(); 25 | if (!vm.ReadForm(source, ref loc, forms)) { throw new ReadError("Missing max", loc); } 26 | var right = forms.PopLast(); 27 | WhiteSpace.Instance.Read(source, vm, forms, ref loc); 28 | c = source.Peek(); 29 | Form? stride = null; 30 | 31 | if (c == ':') 32 | { 33 | source.Read(); 34 | loc.Column++; 35 | if (!vm.ReadForm(source, ref loc, forms)) { throw new ReadError("Missing stride", loc); } 36 | stride = forms.PopLast(); 37 | } 38 | 39 | forms.Push(new Forms.Call(new Forms.Id("range", loc), [left, right, stride ?? new Forms.Nil(loc)], formLoc)); 40 | return true; 41 | } 42 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Splat.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct Splat : Reader 4 | { 5 | public static readonly Splat Instance = new Splat(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | var c = source.Peek(); 10 | if (c is null || c != '*' || forms.Count == 0) { return false; } 11 | var formLoc = loc; 12 | loc.Column++; 13 | source.Read(); 14 | var target = forms.TryPopLast(); 15 | #pragma warning disable CS8604 16 | forms.Push(new Forms.Splat(target, formLoc)); 17 | #pragma warning restore CS8604 18 | return true; 19 | } 20 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/String.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Libs; 2 | using System.Text; 3 | 4 | namespace Sharpl.Readers; 5 | 6 | public struct String : Reader 7 | { 8 | public static readonly String Instance = new String(); 9 | 10 | 11 | public static char? GetEscape(char? c) => c switch 12 | { 13 | 'r' => '\r', 14 | 'n' => '\n', 15 | '\\' => '\\', 16 | '"' => '"', 17 | _ => null 18 | }; 19 | 20 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 21 | { 22 | var c = source.Peek(); 23 | if (c is null || c != '"') { return false; } 24 | source.Read(); 25 | var formLoc = loc; 26 | var s = new StringBuilder(); 27 | 28 | while (true) 29 | { 30 | c = source.Peek(); 31 | if (c is null) { throw new ReadError("Invalid string", loc); } 32 | source.Read(); 33 | loc.Column++; 34 | if (c == '"') { break; } 35 | 36 | if (c == '\\') 37 | { 38 | c = source.Peek(); 39 | 40 | if (GetEscape(source.Peek()) is char ec) 41 | { 42 | source.Read(); 43 | c = ec; 44 | } 45 | else { s.Append('\\'); } 46 | 47 | source.Read(); 48 | } 49 | 50 | s.Append(c); 51 | loc.Column++; 52 | } 53 | 54 | forms.Push(new Forms.Literal(Value.Make(Core.String, s.ToString()), formLoc)); 55 | return true; 56 | } 57 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/Unquote.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct Unquote : Reader 4 | { 5 | public static readonly Unquote Instance = new Unquote(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | var c = source.Peek(); 10 | if (c is null || c != ',') { return false; } 11 | var formLoc = loc; 12 | loc.Column++; 13 | source.Read(); 14 | 15 | if (!vm.ReadForm(source, ref loc, forms)) { throw new ReadError("Missing unquoted form", loc); } 16 | 17 | WhiteSpace.Instance.Read(source, vm, forms, ref loc); 18 | 19 | if (source.Peek() == '*') 20 | { 21 | if (!Splat.Instance.Read(source, vm, forms, ref loc)) { throw new ReadError("Failed reading unquoted splat", loc); } 22 | } 23 | 24 | forms.Push(new Forms.UnquoteForm(forms.PopLast(), formLoc)); 25 | return true; 26 | } 27 | } -------------------------------------------------------------------------------- /src/Sharpl/Readers/WhiteSpace.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Readers; 2 | 3 | public struct WhiteSpace : Reader 4 | { 5 | public static readonly WhiteSpace Instance = new WhiteSpace(); 6 | 7 | public bool Read(Source source, VM vm, Form.Queue forms, ref Loc loc) 8 | { 9 | var done = false; 10 | 11 | while (!done) 12 | { 13 | switch (source.Peek()) 14 | { 15 | case ' ': 16 | case '\t': 17 | loc.Column++; 18 | source.Read(); 19 | break; 20 | case '\r': 21 | case '\n': 22 | loc.NewLine(); 23 | source.Read(); 24 | break; 25 | default: 26 | done = true; 27 | break; 28 | } 29 | } 30 | 31 | return false; 32 | } 33 | } -------------------------------------------------------------------------------- /src/Sharpl/Register.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public readonly record struct Register(int FrameOffset, int Index) 4 | { 5 | public override string ToString() => $"(Register {FrameOffset} {Index})"; 6 | } -------------------------------------------------------------------------------- /src/Sharpl/StackExtensions.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public static class StackExtensions 4 | { 5 | public static string ToString(this List stack, VM vm) => 6 | $"[{string.Join(' ', stack.Select(v => v.Dump(vm)))}]"; 7 | } -------------------------------------------------------------------------------- /src/Sharpl/Sym.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl; 2 | 3 | public class Sym(string name) 4 | { 5 | public string Name => name; 6 | public override string ToString() => $"'{Name}"; 7 | } -------------------------------------------------------------------------------- /src/Sharpl/TaskUtil.cs: -------------------------------------------------------------------------------- 1 | using System.Threading.Channels; 2 | 3 | namespace Sharpl; 4 | 5 | public static class TaskUtil 6 | { 7 | public static async ValueTask> Poll(Channel[] sources) 8 | { 9 | var cts = new CancellationTokenSource(); 10 | var trs = sources.Select(c => (c.Reader.WaitToReadAsync(cts.Token).AsTask(), c)).ToArray(); 11 | return await Any(trs); 12 | } 13 | 14 | public static async ValueTask Any((Task, T)[] sources) => 15 | await Any(sources, new CancellationTokenSource()); 16 | 17 | public static async ValueTask Any((Task, T)[] sources, CancellationTokenSource cts) 18 | { 19 | var lookup = sources.ToDictionary(); 20 | Task ct = await Task.WhenAny(lookup.Keys); 21 | cts.Cancel(); 22 | return lookup[ct]; 23 | } 24 | } -------------------------------------------------------------------------------- /src/Sharpl/Term.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Libs; 2 | using System.Drawing; 3 | using System.Text; 4 | 5 | namespace Sharpl; 6 | 7 | public class Term 8 | { 9 | private readonly StringBuilder buffer = new StringBuilder(); 10 | 11 | public string Ask(VM vm, string? prompt = null, Value? echo = null) 12 | { 13 | if (prompt is not null) { Write(prompt); } 14 | Flush(); 15 | var res = new StringBuilder(); 16 | 17 | while (true) 18 | { 19 | var k = Console.ReadKey(true); 20 | 21 | if (k.Key == ConsoleKey.Enter) 22 | { 23 | Write('\n'); 24 | break; 25 | } 26 | 27 | if (echo is Value v) 28 | { 29 | if ((v.Type != Core.Bit) || v.CastUnbox(Core.Bit)) 30 | { 31 | Console.Write((v.Type == Core.Bit) ? k.KeyChar : v.Say(vm)); 32 | } 33 | } 34 | 35 | res.Append(k.KeyChar); 36 | } 37 | 38 | 39 | 40 | return res.ToString(); 41 | } 42 | 43 | public Term Flush() 44 | { 45 | Console.Write(buffer.ToString()); 46 | buffer.Clear(); 47 | return this; 48 | } 49 | 50 | // TODO: Switch to .NET 9 and replace with 51 | // params ReadOnlySpan args 52 | private void CSI(params object[] args) 53 | { 54 | buffer.Append((char)27); 55 | buffer.Append('['); 56 | foreach (var a in args) { buffer.Append(a); } 57 | } 58 | 59 | public void ClearLine() => CSI(0, 'K'); 60 | public void ClearScreen() => CSI(2, 'J'); 61 | public int Height { get => Console.BufferHeight; } 62 | 63 | 64 | public Term MoveTo(int x, int? y = null) 65 | { 66 | if (y == null) { CSI(x, 'G'); } 67 | else { CSI(y, ';', x, 'H'); } 68 | return this; 69 | } 70 | 71 | public Term Reset() 72 | { 73 | CSI("0m"); 74 | return this; 75 | } 76 | 77 | public void Restore() => CSI('u'); 78 | public void Save() => CSI('s'); 79 | 80 | public void SetRegion((int, int) min, (int, int) max) => 81 | CSI(min.Item2, ';', max.Item2, ';', min.Item1, ';', max.Item1, 'r'); 82 | 83 | public void SetRegion() => CSI('r'); 84 | public void ScrollUp(int lines = 1) => CSI(lines, 'S'); 85 | public void ScrollDown(int lines = 1) => CSI(lines, 'T'); 86 | 87 | public void SetBg(Color color) => 88 | CSI("48;2;", color.R, ';', color.G, ';', color.B, 'm'); 89 | 90 | public Term SetFg(Color color) 91 | { 92 | CSI("38;2;", color.R, ';', color.G, ';', color.B, 'm'); 93 | return this; 94 | } 95 | 96 | public int Width => Console.BufferWidth; 97 | 98 | public Term Write(object value) 99 | { 100 | buffer.Append(value); 101 | return this; 102 | } 103 | 104 | public Term WriteLine(object value) 105 | { 106 | Write($"{value}\n"); 107 | return this; 108 | } 109 | } -------------------------------------------------------------------------------- /src/Sharpl/TimeUtil.cs: -------------------------------------------------------------------------------- 1 | using System.Globalization; 2 | 3 | namespace Sharpl; 4 | 5 | public static class TimeUtil 6 | { 7 | public static int IsoWeek(this DateTime t) 8 | { 9 | // Seriously cheat. If its Monday, Tuesday or Wednesday, then it'll 10 | // be the same week# as whatever Thursday, Friday or Saturday are, 11 | // and we always get those right 12 | 13 | DayOfWeek day = CultureInfo.InvariantCulture.Calendar.GetDayOfWeek(t); 14 | if (day >= DayOfWeek.Monday && day <= DayOfWeek.Wednesday) { t = t.AddDays(3); } 15 | 16 | // Return the week of our adjusted day 17 | return CultureInfo.InvariantCulture.Calendar.GetWeekOfYear(t, CalendarWeekRule.FirstFourDayWeek, DayOfWeek.Monday); 18 | } 19 | } -------------------------------------------------------------------------------- /src/Sharpl/Type.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Forms; 2 | using Sharpl.Libs; 3 | using System.Text; 4 | 5 | namespace Sharpl; 6 | 7 | public abstract class AnyType: IComparable 8 | { 9 | public readonly string Name; 10 | private readonly List parents = new List(); 11 | private readonly Dictionary parentLookup = new Dictionary(); 12 | 13 | public AnyType(string name, AnyType[] parents) 14 | { 15 | Name = name; 16 | AddParent(this); 17 | 18 | foreach (var pt in parents) 19 | { 20 | foreach (var (ppt, _) in pt.parentLookup) { AddParent(ppt); } 21 | } 22 | } 23 | 24 | private void AddParent(AnyType type) 25 | { 26 | if (parentLookup.ContainsKey(type)) { parentLookup[type] += 1; } 27 | else { 28 | parents.Add(type); 29 | parentLookup[type] = 1; 30 | } 31 | } 32 | public virtual bool Bool(Value value) => true; 33 | public virtual void Call(VM vm, Stack stack, int arity, Loc loc) => throw new EvalError("Not supported", loc); 34 | 35 | public virtual void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 36 | { 37 | switch (arity) 38 | { 39 | case 0: 40 | stack.Push(target); 41 | break; 42 | default: 43 | throw new EvalError($"Wrong number of arguments: {this}", loc); 44 | } 45 | } 46 | 47 | public T? Cast() where T : class 48 | { 49 | foreach (var pt in parents) 50 | { 51 | if (pt is T t) { return t; } 52 | } 53 | 54 | return null; 55 | } 56 | 57 | public int CompareTo(AnyType? other) 58 | { 59 | var o = other!; 60 | if (parentLookup.ContainsKey(o)) { return 1; } 61 | if (o.parentLookup.ContainsKey(this)) { return -1; } 62 | return 0; 63 | } 64 | 65 | public virtual Value Copy(Value value) => value; 66 | public virtual void Dump(VM vm, Value value, StringBuilder result) => result.Append(value.Data.ToString()); 67 | public virtual void Emit(VM vm, Value value, Form.Queue args, Loc loc) => vm.Emit(Ops.Push.Make(value)); 68 | 69 | public virtual void EmitCall(VM vm, Value target, Form.Queue args, Loc loc) 70 | { 71 | var arity = args.Count; 72 | var splat = args.IsSplat; 73 | if (splat) { vm.Emit(Ops.PushSplat.Make()); } 74 | UserMethod? um = null; 75 | 76 | if (target.Type == Core.UserMethod) { um = target.Cast(Core.UserMethod); } 77 | 78 | for (int i = 0; i < args.Count; i++) 79 | { 80 | vm.Emit(args.Items[i]); 81 | if (um is not null && i < um.Args.Length && um.Args[i].Unzip) { vm.Emit(Ops.Unzip.Make(loc)); } 82 | } 83 | 84 | args.Clear(); 85 | vm.Emit(Ops.CallDirect.Make(target, arity, splat, vm.NextRegisterIndex, loc)); 86 | } 87 | 88 | public abstract bool Equals(Value left, Value right); 89 | 90 | public virtual bool Isa(AnyType type) => 91 | GetType().IsAssignableFrom(type.GetType()) || parentLookup.ContainsKey(type); 92 | 93 | public AnyType[] Parents => parents.ToArray(); 94 | public virtual void Say(VM vm, Value value, StringBuilder result) => Dump(vm, value, result); 95 | public virtual string ToJson(Value value, Loc loc) => throw new EvalError($"Not supported: {value}", loc); 96 | public override string ToString() => Name; 97 | public virtual Form Unquote(VM vm, Value value, Loc loc) => new Literal(value, loc); 98 | } 99 | 100 | public class Type : AnyType 101 | { 102 | public Type(string name, AnyType[] parents): base(name, parents) { } 103 | public override bool Equals(Value left, Value right) => left.CastSlow(this).Equals(right.CastSlow(this)); 104 | } 105 | 106 | public class BasicType: Type 107 | { 108 | public BasicType(string name, AnyType[] parents): base(name, parents) {} 109 | } 110 | 111 | public class UserTrait: BasicType 112 | { 113 | public UserTrait(string name, UserTrait[] parents): base(name, parents) {} 114 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Array.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Iters.Core; 2 | using System.Text; 3 | 4 | namespace Sharpl.Types.Core; 5 | 6 | using Sharpl.Libs; 7 | 8 | public class ArrayType(string name, AnyType[] parents) : 9 | Type(name, parents), ComparableTrait, IterTrait, LengthTrait, StackTrait 10 | { 11 | public override bool Bool(Value value) => value.Cast(this).Length != 0; 12 | 13 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 14 | { 15 | var vs = new Value[arity]; 16 | for (var i = arity - 1; i >= 0; i--) { vs[i] = stack.Pop(); } 17 | stack.Push(Value.Make(this, vs)); 18 | } 19 | 20 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 21 | { 22 | switch (arity) 23 | { 24 | case 1: 25 | { 26 | var iv = stack.Pop(); 27 | var t = target.Cast(this); 28 | 29 | if (iv.Type == Core.Pair) 30 | { 31 | var p = iv.CastUnbox(Core.Pair); 32 | var i = (p.Item1.Type == Core.Nil) ? 0 : p.Item1.CastUnbox(Core.Int, loc); 33 | var n = (p.Item2.Type == Core.Nil) ? t.Length - 1 : p.Item2.CastUnbox(Core.Int, loc); 34 | stack.Push(Core.Array, t[i..(i + n)]); 35 | } 36 | else 37 | { 38 | stack.Push(t[iv.CastUnbox(Core.Int)]); 39 | } 40 | 41 | break; 42 | } 43 | case 2: 44 | { 45 | var v = stack.Pop(); 46 | target.Cast(this)[stack.Pop().CastUnbox(Core.Int)] = v; 47 | break; 48 | } 49 | default: 50 | throw new EvalError($"Wrong number of arguments: {arity}", loc); 51 | 52 | } 53 | } 54 | 55 | public Order Compare(Value left, Value right) 56 | { 57 | var lvs = left.Cast(this); 58 | var rvs = right.Cast(this); 59 | var res = ComparableTrait.IntOrder(lvs.Length.CompareTo(rvs.Length)); 60 | 61 | for (var i = 0; i < lvs.Length && res != Order.EQ; i++) 62 | { 63 | var lv = lvs[i]; 64 | var rv = rvs[i]; 65 | if (lv.Type != rv.Type) { throw new Exception($"Type mismatch: {lv} {rv}"); } 66 | if (lv.Type is ComparableTrait t && rv.Type is ComparableTrait) { res = t.Compare(lv, rv); } 67 | else { throw new Exception($"Not comparable: {lv} {rv}"); } 68 | } 69 | 70 | return res; 71 | } 72 | 73 | public Sharpl.Iter CreateIter(Value target, VM vm, Loc loc) => 74 | new EnumeratorItems(((IEnumerable)target.Cast(this)).GetEnumerator()); 75 | 76 | public override Value Copy(Value value) => 77 | Value.Make(this, value.Cast(this).Select(it => it.Copy()).ToArray()); 78 | 79 | public override void Dump(VM vm, Value value, StringBuilder result) 80 | { 81 | result.Append('['); 82 | var i = 0; 83 | 84 | foreach (var v in value.Cast(this)) 85 | { 86 | if (i > 0) { result.Append(' '); } 87 | v.Dump(vm, result); 88 | i++; 89 | } 90 | 91 | result.Append(']'); 92 | } 93 | 94 | public override bool Equals(Value left, Value right) 95 | { 96 | var lv = left.Cast(this); 97 | var rv = right.Cast(this); 98 | if (lv.Length != rv.Length) { return false; } 99 | 100 | for (var i = 0; i < lv.Length; i++) 101 | { 102 | if (!lv[i].Equals(rv[i])) { return false; } 103 | } 104 | 105 | return true; 106 | } 107 | 108 | public int Length(Value target) => target.Cast(this).Length; 109 | 110 | public Value Peek(Loc loc, VM vm, Value srcVal) 111 | { 112 | var src = srcVal.Cast(this); 113 | return (src.Length == 0) ? Value._ : src[^1]; 114 | } 115 | 116 | public Value Pop(Loc loc, VM vm, Register src, Value srcVal) 117 | { 118 | var sv = srcVal.Cast(this); 119 | if (sv.Length == 0) { return Value._; } 120 | var v = sv[^1]; 121 | vm.Set(src, Value.Make(this, sv[0..^1])); 122 | return v; 123 | } 124 | 125 | public void Push(Loc loc, VM vm, Register dst, Value dstVal, Value val) 126 | { 127 | var dv = dstVal.Cast(this); 128 | var i = dv.Length; 129 | Array.Resize(ref dv, i + 1); 130 | dv[i] = val; 131 | vm.Set(dst, Value.Make(this, dv)); 132 | } 133 | 134 | public override void Say(VM vm, Value value, StringBuilder result) 135 | { 136 | result.Append('['); 137 | var i = 0; 138 | 139 | foreach (var v in value.Cast(this)) 140 | { 141 | if (i > 0) { result.Append(' '); } 142 | v.Say(vm, result); 143 | i++; 144 | } 145 | 146 | result.Append(']'); 147 | } 148 | 149 | public override string ToJson(Value value, Loc loc) => 150 | $"[{string.Join(',', value.Cast(this).Select(it => it.ToJson(loc)).ToArray())}]"; 151 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Binding.cs: -------------------------------------------------------------------------------- 1 | using System.Xml.Linq; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class BindingType(string name, AnyType[] parents) : Type(name, parents) 6 | { 7 | public override void EmitCall(VM vm, Value target, Form.Queue args, Loc loc) 8 | { 9 | var arity = args.Count; 10 | var splat = args.IsSplat; 11 | args.Emit(vm); 12 | var v = target.CastUnbox(this); 13 | vm.Emit(Ops.CallRegister.Make(v, arity, splat, vm.NextRegisterIndex, loc)); 14 | } 15 | 16 | public override void Emit(VM vm, Value target, Form.Queue args, Loc loc) => 17 | vm.Emit(Ops.GetRegister.Make(target.CastUnbox(this))); 18 | 19 | public override Form Unquote(VM vm, Value value, Loc loc) => 20 | new Forms.Binding(value.CastUnbox(this), loc); 21 | } 22 | -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Bit.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class BitType(string name, AnyType[] parents) : ComparableType(name, parents) 6 | { 7 | public override bool Bool(Value value) => value.CastUnbox(this); 8 | public override void Call(VM vm, Stack stack, int arity, Loc loc) => stack.Push(this, (bool)stack.Pop()); 9 | public override void Dump(VM vm, Value value, StringBuilder result) => result.Append(value.CastUnbox(this) ? 'T' : 'F'); 10 | public override string ToJson(Value value, Loc loc) => value.CastUnbox(this) ? "true" : "false"; 11 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Char.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class CharType(string name, AnyType[] parents) : 6 | ComparableType(name, parents), RangeTrait 7 | { 8 | public override bool Bool(Value value) => value.CastUnbox(this) != 0; 9 | 10 | public Iter CreateRange(Value min, Value max, Value stride, Loc loc) 11 | { 12 | char minVal = (min.Type == Libs.Core.Nil) ? '\0' : min.CastUnbox(this, loc); 13 | char? maxVal = (max.Type == Libs.Core.Nil) ? null : max.CastUnbox(this, loc); 14 | int strideVal = (stride.Type == Libs.Core.Nil) ? ((maxVal is char mv && maxVal < minVal) ? -1 : 1) : stride.CastUnbox(Libs.Core.Int, loc); 15 | return new Iters.Core.CharRange(minVal, maxVal, strideVal); 16 | } 17 | 18 | public override void Dump(VM vm, Value value, StringBuilder result) 19 | { 20 | var c = value.CastUnbox(this); 21 | result.Append('\\'); 22 | 23 | result.Append(c switch 24 | { 25 | '\n' => "\\n", 26 | '\r' => "\\r", 27 | _ => $"{c}" 28 | }); 29 | } 30 | 31 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 32 | { 33 | var c = target.CastUnbox(this); 34 | var r = true; 35 | 36 | while (arity > 0) 37 | { 38 | if (stack.Pop().CastUnbox(this) != c) { 39 | r = false; 40 | break; 41 | } 42 | 43 | arity--; 44 | } 45 | 46 | stack.Push(Libs.Core.Bit, r); 47 | } 48 | 49 | public override void Say(VM vm, Value value, StringBuilder result) => 50 | result.Append(value.CastUnbox(this)); 51 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/CloseTrait.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public interface CloseTrait 4 | { 5 | void Close(Value target); 6 | }; -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Color.cs: -------------------------------------------------------------------------------- 1 | using System.Drawing; 2 | using System.Text; 3 | 4 | namespace Sharpl.Types.Core; 5 | 6 | public class ColorType(string name, AnyType[] parents) : Type(name, parents) 7 | { 8 | public override void Dump(VM vm, Value value, StringBuilder result) 9 | { 10 | var c = value.CastUnbox(this); 11 | result.Append($"(Color {c.R} {c.G} {c.B} {c.A})"); 12 | } 13 | } 14 | -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/ComparableTrait.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public interface ComparableTrait 4 | { 5 | static Order IntOrder(int value) => (Order)Math.Sign(value); 6 | static int OrderInt(Order value) => (int)value; 7 | Order Compare(Value left, Value right); 8 | }; -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/ComparableType.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public class ComparableType(string name, AnyType[] parents) : 4 | Type(name, parents), ComparableTrait where T : IComparable 5 | { 6 | public Order Compare(Value left, Value right) 7 | { 8 | var lv = left.CastSlow(this); 9 | var rv = right.CastSlow(this); 10 | return ComparableTrait.IntOrder(lv.CompareTo(rv)); 11 | } 12 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/DurationType.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class DurationType(string name, AnyType[] parents) : 6 | ComparableType(name, parents), NumericTrait 7 | { 8 | public static readonly Duration ZERO = new Duration(0, TimeSpan.FromTicks(0)); 9 | 10 | public void Add(VM vm, Stack stack, int arity, Loc loc) 11 | { 12 | var res = new Duration(0, TimeSpan.FromTicks(0)); 13 | 14 | while (arity > 0) 15 | { 16 | res = stack.Pop().CastUnbox(this, loc).Add(res); 17 | arity--; 18 | } 19 | 20 | stack.Push(this, res); 21 | } 22 | 23 | public override bool Bool(Value value) => value.CastUnbox(this).CompareTo(ZERO) > 0; 24 | 25 | public void Divide(VM vm, Stack stack, int arity, Loc loc) 26 | { 27 | stack.Reverse(arity); 28 | var res = stack.Pop().CastUnbox(this, loc); 29 | arity--; 30 | 31 | while (arity > 0) 32 | { 33 | res = res.Divide(stack.Pop().CastUnbox(Libs.Core.Int, loc)); 34 | arity--; 35 | } 36 | 37 | stack.Push(this, res); 38 | } 39 | 40 | public void Multiply(VM vm, Stack stack, int arity, Loc loc) 41 | { 42 | var res = stack.Pop().CastUnbox(this, loc); 43 | arity--; 44 | 45 | while (arity > 0) 46 | { 47 | res = res.Multiply(stack.Pop().CastUnbox(Libs.Core.Int, loc)); 48 | arity--; 49 | } 50 | 51 | stack.Push(this, res); 52 | } 53 | 54 | public void Subtract(VM vm, Stack stack, int arity, Loc loc) 55 | { 56 | var res = new Duration(0, TimeSpan.FromTicks(0)); 57 | 58 | if (arity > 0) 59 | { 60 | if (arity == 1) { res = res.Subtract(stack.Pop().CastUnbox(this, loc)); } 61 | else 62 | { 63 | stack.Reverse(arity); 64 | res = stack.Pop().CastUnbox(this, loc); 65 | arity--; 66 | 67 | while (arity > 0) 68 | { 69 | res = res.Subtract(stack.Pop().CastUnbox(this, loc)); 70 | arity--; 71 | } 72 | } 73 | } 74 | 75 | stack.Push(this, res); 76 | } 77 | 78 | public override void Say(VM vm, Value value, StringBuilder result) => result.Append(value.CastUnbox(this)); 79 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/ErrorType.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class ErrorType(string name, AnyType[] parents) : Type(name, parents) 6 | { 7 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 8 | { 9 | var res = new StringBuilder(); 10 | 11 | while (arity > 0) 12 | { 13 | stack.Pop().Say(vm, res); 14 | arity--; 15 | } 16 | 17 | stack.Push(Libs.Core.String, res.ToString()); 18 | } 19 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Fix.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class FixType(string name, AnyType[] parents) : 6 | ComparableType(name, parents), 7 | NumericTrait, 8 | RangeTrait 9 | { 10 | public override bool Bool(Value value) => Fix.Val(value.CastUnbox(this)) != 0; 11 | 12 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 13 | { 14 | var v = stack.Pop().CastUnbox(Libs.Core.Int, loc); 15 | var e = stack.Pop().CastUnbox(Libs.Core.Int, loc); 16 | stack.Push(Value.Make(Libs.Core.Fix, Fix.Make((byte)e, v))); 17 | } 18 | 19 | public Iter CreateRange(Value min, Value max, Value stride, Loc loc) 20 | { 21 | ulong? minVal = min.TryCastUnbox(this); 22 | ulong? maxVal = max.TryCastUnbox(this); 23 | if (stride.Type == Libs.Core.Nil) { throw new EvalError("Missing stride", loc); } 24 | ulong strideVal = stride.CastUnbox(this); 25 | return new Iters.Core.FixRange(minVal ?? Fix.Make(1, 0), maxVal, strideVal); 26 | } 27 | 28 | public override void Dump(VM vm, Value value, StringBuilder result) => 29 | result.Append(Fix.ToString(value.CastUnbox(this))); 30 | 31 | public void Add(VM vm, Stack stack, int arity, Loc loc) 32 | { 33 | if (arity == 0) { stack.Push(this, Fix.Make(1, 0)); } 34 | var res = stack.Pop().CastUnbox(this, loc); 35 | arity--; 36 | 37 | while (arity > 0) 38 | { 39 | res = Fix.Add(res, stack.Pop().CastUnbox(this, loc)); 40 | arity--; 41 | } 42 | 43 | stack.Push(this, res); 44 | } 45 | 46 | public void Divide(VM vm, Stack stack, int arity, Loc loc) 47 | { 48 | if (arity == 0) { stack.Push(this, Fix.Make(1, 0)); } 49 | stack.Reverse(arity); 50 | var res = stack.Pop().CastUnbox(this, loc); 51 | arity--; 52 | 53 | while (arity > 0) 54 | { 55 | res = Fix.Divide(res, stack.Pop().CastUnbox(this, loc)); 56 | arity--; 57 | } 58 | 59 | stack.Push(this, res); 60 | } 61 | 62 | public override bool Equals(Value left, Value right) => 63 | Fix.Equals(left.CastUnbox(this), right.CastUnbox(this)); 64 | 65 | public void Multiply(VM vm, Stack stack, int arity, Loc loc) 66 | { 67 | if (arity == 0) { stack.Push(this, Fix.Make(1, 0)); } 68 | var res = stack.Pop().CastUnbox(this, loc); 69 | arity--; 70 | 71 | while (arity > 0) 72 | { 73 | res = Fix.Multiply(res, stack.Pop().CastUnbox(this, loc)); 74 | arity--; 75 | } 76 | 77 | stack.Push(this, res); 78 | } 79 | 80 | public void Subtract(VM vm, Stack stack, int arity, Loc loc) 81 | { 82 | var res = Fix.Make(1, 0); 83 | 84 | if (arity > 0) 85 | { 86 | if (arity == 1) 87 | { 88 | res = Fix.Negate(stack.Pop().CastUnbox(this, loc)); 89 | 90 | } 91 | else 92 | { 93 | stack.Reverse(arity); 94 | res = stack.Pop().CastUnbox(this, loc); 95 | arity--; 96 | 97 | while (arity > 0) 98 | { 99 | res = Fix.Subtract(res, stack.Pop().CastUnbox(this, loc)); 100 | arity--; 101 | } 102 | } 103 | } 104 | 105 | stack.Push(this, res); 106 | } 107 | 108 | public override string ToJson(Value value, Loc loc) => Fix.ToString(value.CastUnbox(this), true); 109 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Form.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class FormType(string name, AnyType[] parents) : Type
(name, parents) 6 | { 7 | public override void Dump(VM vm, Value value, StringBuilder result) => result.Append(value.Cast(this)); 8 | public override bool Equals(Value left, Value right) => left.Cast(this).Equals(right.Cast(this)); 9 | public override Form Unquote(VM vm, Value value, Loc loc) => value.Cast(this).Unquote(vm, loc); 10 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Int.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public class IntType(string name, AnyType[] parents) : 4 | ComparableType(name, parents), NumericTrait, RangeTrait 5 | { 6 | public override bool Bool(Value value) => value.CastUnbox(this) != 0; 7 | 8 | public Iter CreateRange(Value min, Value max, Value stride, Loc loc) 9 | { 10 | int minVal = (min.Type == Libs.Core.Nil) ? 0 : min.CastUnbox(this, loc); 11 | int? maxVal = (max.Type == Libs.Core.Nil) ? null : max.CastUnbox(this, loc); 12 | int strideVal = (stride.Type == Libs.Core.Nil) ? ((maxVal is int mv && maxVal < minVal) ? -1 : 1) : stride.CastUnbox(this, loc); 13 | return new Iters.Core.IntRange(minVal, maxVal, strideVal); 14 | } 15 | 16 | public void Add(VM vm, Stack stack, int arity, Loc loc) 17 | { 18 | var res = 0; 19 | 20 | while (arity > 0) 21 | { 22 | res += stack.Pop().CastUnbox(this, loc); 23 | arity--; 24 | } 25 | 26 | stack.Push(this, res); 27 | } 28 | 29 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 30 | { 31 | switch (arity) 32 | { 33 | case 1: 34 | var nt = stack.Pop(); 35 | stack.Push(target); 36 | nt.Call(vm, stack, 1, registerCount, eval, loc); 37 | break; 38 | default: 39 | base.Call(vm, stack, target, arity, registerCount, eval, loc); 40 | break; 41 | } 42 | } 43 | 44 | public void Divide(VM vm, Stack stack, int arity, Loc loc) 45 | { 46 | stack.Reverse(arity); 47 | var res = stack.Pop().CastUnbox(this, loc); 48 | arity--; 49 | 50 | while (arity > 0) 51 | { 52 | res /= stack.Pop().CastUnbox(this, loc); 53 | arity--; 54 | } 55 | 56 | stack.Push(this, res); 57 | } 58 | 59 | public void Multiply(VM vm, Stack stack, int arity, Loc loc) 60 | { 61 | var res = stack.Pop().CastUnbox(this, loc); 62 | arity--; 63 | 64 | while (arity > 0) 65 | { 66 | res *= stack.Pop().CastUnbox(this, loc); 67 | arity--; 68 | } 69 | 70 | stack.Push(this, res); 71 | } 72 | 73 | public void Subtract(VM vm, Stack stack, int arity, Loc loc) 74 | { 75 | var res = 0; 76 | 77 | if (arity > 0) 78 | { 79 | if (arity == 1) { res = -stack.Pop().CastUnbox(this, loc); } 80 | else 81 | { 82 | stack.Reverse(arity); 83 | res = stack.Pop().CastUnbox(this, loc); 84 | arity--; 85 | 86 | while (arity > 0) 87 | { 88 | res -= stack.Pop().CastUnbox(this, loc); 89 | arity--; 90 | } 91 | } 92 | } 93 | 94 | stack.Push(this, res); 95 | } 96 | 97 | public override string ToJson(Value value, Loc loc) => $"{value.CastUnbox(this)}"; 98 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Iter.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class IterType(string name, AnyType[] parents) : Type(name, parents), IterTrait 6 | { 7 | public override void Dump(VM vm, Value value, StringBuilder result) => result.Append($"{value.Cast(this).Dump(vm)}"); 8 | public Iter CreateIter(Value target, VM vm, Loc loc) => target.Cast(this); 9 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/IterTrait.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public interface IterTrait 4 | { 5 | Iter CreateIter(Value target, VM vm, Loc loc); 6 | }; -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/LengthTrait.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public interface LengthTrait 4 | { 5 | int Length(Value target); 6 | }; -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Lib.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public class LibType(string name, AnyType[] parents) : Type(name, parents) { } 4 | -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/List.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Iters.Core; 2 | using System.Text; 3 | 4 | namespace Sharpl.Types.Core; 5 | 6 | using Sharpl.Libs; 7 | 8 | public class ListType(string name, AnyType[] parents) : 9 | Type>(name, parents), ComparableTrait, IterTrait, LengthTrait, StackTrait 10 | { 11 | public override bool Bool(Value value) => value.Cast(this).Count != 0; 12 | 13 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 14 | { 15 | stack.Reverse(arity); 16 | var vs = new List(arity); 17 | for (var i = arity - 1; i >= 0; i--) { vs.Add(stack.Pop()); } 18 | stack.Push(Value.Make(this, vs)); 19 | } 20 | 21 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 22 | { 23 | switch (arity) 24 | { 25 | case 1: 26 | { 27 | var t = target.Cast(this); 28 | var iv = stack.Pop(); 29 | 30 | if (iv.Type == Core.Pair) 31 | { 32 | var p = iv.CastUnbox(Core.Pair); 33 | var i = (p.Item1.Type == Core.Nil) ? 0 : p.Item1.CastUnbox(Core.Int, loc); 34 | var n = (p.Item2.Type == Core.Nil) ? t.Count - 1 : p.Item2.CastUnbox(Core.Int, loc); 35 | stack.Push(Core.List, t[i..(i + n)]); 36 | } 37 | else 38 | { 39 | var i = iv.CastUnbox(Core.Int); 40 | stack.Push(t[i]); 41 | } 42 | 43 | break; 44 | } 45 | case 2: 46 | { 47 | var v = stack.Pop(); 48 | target.Cast(this)[stack.Pop().CastUnbox(Core.Int)] = v; 49 | break; 50 | } 51 | default: 52 | throw new EvalError($"Wrong number of arguments: {arity}", loc); 53 | 54 | } 55 | } 56 | 57 | public Order Compare(Value left, Value right) 58 | { 59 | var lvs = left.Cast(this); 60 | var rvs = right.Cast(this); 61 | var res = ComparableTrait.IntOrder(lvs.Count.CompareTo(rvs.Count)); 62 | 63 | for (var i = 0; i < lvs.Count && res != Order.EQ; i++) 64 | { 65 | var lv = lvs[i]; 66 | var rv = rvs[i]; 67 | if (lv.Type != rv.Type) { throw new Exception($"Type mismatch: {lv} {rv}"); } 68 | if (lv.Type is ComparableTrait t && rv.Type is ComparableTrait) { res = t.Compare(lv, rv); } 69 | else { throw new Exception($"Not comparable: {lv} {rv}"); } 70 | } 71 | 72 | return res; 73 | } 74 | 75 | public Sharpl.Iter CreateIter(Value target, VM vm, Loc loc) => 76 | new EnumeratorItems(target.Cast(this).GetEnumerator()); 77 | 78 | public override Value Copy(Value value) => 79 | Value.Make(this, new List(value.Cast(this).Select(it => it.Copy()))); 80 | 81 | public override void Dump(VM vm, Value value, StringBuilder result) 82 | { 83 | result.Append("(List"); 84 | 85 | foreach (var v in value.Cast(this)) 86 | { 87 | result.Append(' '); 88 | v.Dump(vm, result); 89 | } 90 | 91 | result.Append(')'); 92 | } 93 | 94 | public override bool Equals(Value left, Value right) 95 | { 96 | var lv = left.Cast(this); 97 | var rv = right.Cast(this); 98 | if (lv.Count != rv.Count) { return false; } 99 | 100 | for (var i = 0; i < lv.Count; i++) 101 | { 102 | if (!lv[i].Equals(rv[i])) { return false; } 103 | } 104 | 105 | return true; 106 | } 107 | 108 | public int Length(Value target) => target.Cast(this).Count; 109 | 110 | public Value Peek(Loc loc, VM vm, Value srcVal) 111 | { 112 | var src = srcVal.Cast(this); 113 | return (src.Count == 0) ? Value._ : src[^1]; 114 | } 115 | 116 | public Value Pop(Loc loc, VM vm, Register src, Value srcVal) 117 | { 118 | var sv = srcVal.Cast(this); 119 | var n = sv.Count; 120 | if (n == 0) { return Value._; } 121 | n--; 122 | var v = sv[n]; 123 | sv.RemoveAt(n); 124 | return v; 125 | } 126 | 127 | public void Push(Loc loc, VM vm, Register dst, Value dstVal, Value val) => 128 | dstVal.Cast(this).Add(val); 129 | 130 | public override void Say(VM vm, Value value, StringBuilder result) 131 | { 132 | result.Append("(List"); 133 | 134 | foreach (var v in value.Cast(this)) 135 | { 136 | result.Append(' '); 137 | v.Say(vm, result); 138 | } 139 | 140 | result.Append(')'); 141 | } 142 | 143 | public override string ToJson(Value value, Loc loc) => 144 | $"[{string.Join(',', value.Cast(this).Select(it => it.ToJson(loc)).ToArray())}]"; 145 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/LocType.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public class LocType(string name, AnyType[] parents) : ComparableType(name, parents) 4 | { } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Macro.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public class MacroType(string name, AnyType[] parents) : Type(name, parents) 4 | { 5 | public override void EmitCall(VM vm, Value target, Form.Queue args, Loc loc) 6 | { 7 | target.CastUnbox(this).Emit(vm, args, loc); 8 | args.Emit(vm); 9 | } 10 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Map.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class MapType(string name, AnyType[] parents) : 6 | Type>(name, parents), ComparableTrait, IterTrait, LengthTrait 7 | { 8 | public override bool Bool(Value value) => value.Cast(this).Count != 0; 9 | 10 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 11 | { 12 | var m = new OrderedMap(); 13 | 14 | for (var i = 0; i < arity; i++) 15 | { 16 | var p = stack.Pop().CastUnbox(Libs.Core.Pair, loc); 17 | m[p.Item1] = p.Item2; 18 | } 19 | 20 | stack.Push(Value.Make(this, m)); 21 | } 22 | 23 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 24 | { 25 | switch (arity) 26 | { 27 | case 1: 28 | { 29 | var m = target.Cast(this); 30 | var kv = stack.Pop(); 31 | 32 | if (kv.Type == Libs.Core.Pair) 33 | { 34 | var p = kv.CastUnbox(Libs.Core.Pair); 35 | var i = (p.Item1.Type == Libs.Core.Nil) ? 0 : m.IndexOf(p.Item1); 36 | if (i == -1) { throw new EvalError($"Key not found: {p.Item1}", loc); } 37 | var j = (p.Item2.Type == Libs.Core.Nil) ? m.Count - 1 : m.IndexOf(p.Item2); 38 | if (j == -1) { throw new EvalError($"Key not found: {p.Item2}", loc); } 39 | stack.Push(Libs.Core.Map, new OrderedMap(m.Items[i..(j + 1)])); 40 | } 41 | else { stack.Push(m.ContainsKey(kv) ? m[kv] : Value._); } 42 | 43 | break; 44 | } 45 | case 2: 46 | { 47 | var m = target.Cast(this); 48 | var v = stack.Pop(); 49 | if (v.Equals(Value._)) { m.Remove(stack.Pop()); } 50 | else { m.Set(stack.Pop(), v); } 51 | break; 52 | } 53 | default: 54 | throw new EvalError($"Wrong number of arguments: {arity}", loc); 55 | 56 | } 57 | } 58 | 59 | public Order Compare(Value left, Value right) 60 | { 61 | var lm = left.Cast(this); 62 | var rm = right.Cast(this); 63 | var res = ComparableTrait.IntOrder(lm.Count.CompareTo(rm.Count)); 64 | 65 | for (var i = 0; i < lm.Count && res != Order.EQ; i++) 66 | { 67 | var lv = lm.Items[i].Item1; 68 | var rv = rm.Items[i].Item1; 69 | if (lv.Type != rv.Type) { throw new Exception($"Type mismatch: {lv} {rv}"); } 70 | if (lv.Type is ComparableTrait t && rv.Type is ComparableTrait) { res = t.Compare(lv, rv); } 71 | else { throw new Exception($"Not comparable: {lv} {rv}"); } 72 | } 73 | 74 | return res; 75 | } 76 | 77 | 78 | public Iter CreateIter(Value target, VM vm, Loc loc) => 79 | new Iters.Core.EnumeratorItems(target.Cast(this).Items.Select(v => Value.Make(Libs.Core.Pair, v)).GetEnumerator()); 80 | 81 | public override Value Copy(Value value) => 82 | Value.Make(this, new OrderedMap(value.Cast(this).Items.Select(it => (it.Item1.Copy(), it.Item2.Copy())).ToArray())); 83 | 84 | public override void Dump(VM vm, Value value, StringBuilder result) 85 | { 86 | result.Append('{'); 87 | var i = 0; 88 | 89 | foreach (var v in value.Cast(this)) 90 | { 91 | if (i > 0) { result.Append(' '); } 92 | v.Item1.Dump(vm, result); 93 | result.Append(':'); 94 | v.Item2.Dump(vm, result); 95 | i++; 96 | } 97 | 98 | result.Append('}'); 99 | } 100 | 101 | public override bool Equals(Value left, Value right) 102 | { 103 | var lv = left.Cast(this); 104 | var rv = right.Cast(this); 105 | if (lv.Count != rv.Count) { return false; } 106 | 107 | for (var i = 0; i < lv.Count; i++) 108 | { 109 | if (!lv.Items[i].Equals(rv.Items[i])) { return false; } 110 | } 111 | 112 | return true; 113 | } 114 | 115 | public int Length(Value target) => target.Cast(this).Count; 116 | 117 | public override void Say(VM vm, Value value, StringBuilder result) 118 | { 119 | result.Append('{'); 120 | var i = 0; 121 | 122 | foreach (var v in value.Cast(this)) 123 | { 124 | if (i > 0) { result.Append(' '); } 125 | v.Item1.Say(vm, result); 126 | result.Append(':'); 127 | v.Item2.Say(vm, result); 128 | i++; 129 | } 130 | 131 | result.Append('}'); 132 | } 133 | 134 | public override string ToJson(Value value, Loc loc) => 135 | $"{{{string.Join(',', value.Cast(this).Items.Select(it => $"{it.Item1.ToJson(loc)}:{it.Item2.ToJson(loc)}").ToArray())}}}"; 136 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Meta.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public class MetaType(string name, AnyType[] parents) : ComparableType(name, parents) 4 | { 5 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) => 6 | target.Cast(this).Call(vm, stack, arity, loc); 7 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Method.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public class MethodType(string name, AnyType[] parents) : Type(name, parents) 4 | { 5 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) => 6 | target.CastUnbox(this).Call(vm, stack, arity, loc); 7 | 8 | public override void EmitCall(VM vm, Value target, Form.Queue args, Loc loc) 9 | { 10 | var m = target.CastUnbox(this); 11 | var arity = args.Count; 12 | var splat = args.IsSplat; 13 | if (!splat && arity < m.MinArgCount) { throw new EmitError($"Not enough arguments: {m}", loc); } 14 | if (splat) { vm.Emit(Ops.PushSplat.Make()); } 15 | args.Emit(vm); 16 | vm.Emit(Ops.CallMethod.Make(m, arity, splat, loc)); 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Nil.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class NilType(string name, AnyType[] parents) : Type(name, parents), IterTrait 6 | { 7 | public override bool Bool(Value value) => false; 8 | public Iter CreateIter(Value target, VM vm, Loc loc) => Iters.Core.Nil.Instance; 9 | public override void Dump(VM vm, Value value, StringBuilder result) => result.Append('_'); 10 | public override string ToJson(Value value, Loc loc) => "null"; 11 | } 12 | -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/NumericTrait.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public interface NumericTrait 4 | { 5 | void Add(VM vm, Stack stack, int arity, Loc loc); 6 | void Divide(VM vm, Stack stack, int arity, Loc loc); 7 | void Multiply(VM vm, Stack stack, int arity, Loc loc); 8 | void Subtract(VM vm, Stack stack, int arity, Loc loc); 9 | }; -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Pair.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Iters.Core; 2 | using System.Text; 3 | 4 | namespace Sharpl.Types.Core; 5 | 6 | using Sharpl.Libs; 7 | 8 | public class PairType(string name, AnyType[] parents) : 9 | Type<(Value, Value)>(name, parents), ComparableTrait, IterTrait, LengthTrait, StackTrait 10 | { 11 | public static Value Update(Loc loc, Value target, Value value, int i) 12 | { 13 | if (i == 0) 14 | { 15 | return (target.Type == Core.Pair) 16 | ? Value.Make(Core.Pair, (value, target.CastUnbox(Core.Pair).Item2)) 17 | : value; 18 | } 19 | 20 | if (target.Type == Core.Pair) 21 | { 22 | var p = target.CastUnbox(Core.Pair); 23 | return Value.Make(Core.Pair, (p.Item1, Update(loc, p.Item2, value, i - 1))); 24 | } 25 | 26 | throw new EvalError("Index out of bounds", loc); 27 | } 28 | 29 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 30 | { 31 | if (arity < 2) { throw new EvalError("Wrong number of arguments", loc); } 32 | var r = stack.Pop(); 33 | arity--; 34 | 35 | while (arity > 0) 36 | { 37 | var l = stack.Pop(); 38 | r = Value.Make(Core.Pair, (l, r)); 39 | arity--; 40 | } 41 | 42 | stack.Push(r); 43 | } 44 | 45 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 46 | { 47 | switch (arity) 48 | { 49 | case 1: 50 | { 51 | var t = target; 52 | 53 | for (var i = stack.Pop().CastUnbox(Core.Int, loc); i >= 0; i--) 54 | { 55 | switch (i) 56 | { 57 | case 0: 58 | stack.Push(t.CastUnbox(this, loc).Item1); 59 | break; 60 | case 1: 61 | stack.Push(t.CastUnbox(this, loc).Item2); 62 | return; 63 | default: 64 | t = t.CastUnbox(this, loc).Item2; 65 | break; 66 | } 67 | } 68 | 69 | break; 70 | } 71 | case 2: 72 | { 73 | var v = stack.Pop(); 74 | var i = stack.Pop().CastUnbox(Core.Int, loc); 75 | stack.Push(Update(loc, target, v, i)); 76 | break; 77 | } 78 | default: 79 | throw new EvalError($"Wrong number of arguments: {arity}", loc); 80 | } 81 | } 82 | 83 | public Order Compare(Value left, Value right) 84 | { 85 | var lp = left.CastUnbox(this); 86 | var rp = right.CastUnbox(this); 87 | 88 | if (lp.Item1.Type is ComparableTrait t) 89 | { 90 | var res = t.Compare(lp.Item1, rp.Item1); 91 | return (res == Order.EQ) ? t.Compare(lp.Item2, rp.Item2) : res; 92 | } 93 | 94 | return Order.EQ; 95 | } 96 | 97 | public Sharpl.Iter CreateIter(Value target, VM vm, Loc loc) => new PairItems(target); 98 | 99 | public override Value Copy(Value value) 100 | { 101 | var p = value.CastUnbox(this); 102 | return Value.Make(this, (p.Item1.Copy(), p.Item2.Copy())); 103 | } 104 | 105 | public override void Dump(VM vm, Value value, StringBuilder result) 106 | { 107 | var p = value.CastUnbox(this); 108 | p.Item1.Dump(vm, result); 109 | result.Append(':'); 110 | p.Item2.Dump(vm, result); 111 | } 112 | 113 | public override bool Equals(Value left, Value right) 114 | { 115 | var lp = left.CastUnbox(this); 116 | var rp = right.CastUnbox(this); 117 | return lp.Item1.Equals(rp.Item1) && lp.Item2.Equals(rp.Item2); 118 | } 119 | 120 | public int Length(Value target) 121 | { 122 | var v = target; 123 | var result = 1; 124 | 125 | while (v.Type == this) 126 | { 127 | var p = v.CastUnbox(this); 128 | v = p.Item2; 129 | result++; 130 | } 131 | 132 | return result; 133 | } 134 | 135 | public Value Peek(Loc loc, VM vm, Value srcVal) => srcVal.CastUnbox(this).Item1; 136 | 137 | public Value Pop(Loc loc, VM vm, Register src, Value srcVal) 138 | { 139 | var sv = srcVal.CastUnbox(this); 140 | vm.Set(src, sv.Item2); 141 | return sv.Item1; 142 | } 143 | 144 | public void Push(Loc loc, VM vm, Register dst, Value dstVal, Value val) => 145 | vm.Set(dst, Value.Make(this, (val, dstVal))); 146 | 147 | public override void Say(VM vm, Value value, StringBuilder result) 148 | { 149 | var p = value.CastUnbox(this); 150 | p.Item1.Say(vm, result); 151 | result.Append(':'); 152 | p.Item2.Say(vm, result); 153 | } 154 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Pipe.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Iters.Core; 2 | using System.Text; 3 | using System.Threading.Channels; 4 | 5 | namespace Sharpl.Types.Core; 6 | 7 | public class PipeType(string name, AnyType[] parents) : Type>(name, parents), IterTrait, PollTrait 8 | { 9 | public static Channel Make() => Channel.CreateUnbounded(); 10 | 11 | public override void Call(VM vm, Stack stack, int arity, Loc loc) => 12 | stack.Push(Libs.Core.Pipe, Channel.CreateUnbounded()); 13 | 14 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 15 | { 16 | var t = target.Cast(this, loc); 17 | 18 | switch (arity) 19 | { 20 | case 0: 21 | stack.Push(Task.Run(async () => await t.Reader.ReadAsync()).Result); 22 | break; 23 | case 1: 24 | var v = stack.Pop(); 25 | Task.Run(async () => await t.Writer.WriteAsync(v)); 26 | break; 27 | default: 28 | throw new EvalError("Invalid arguments", loc); 29 | } 30 | } 31 | 32 | public Iter CreateIter(Value target, VM vm, Loc loc) => new PipeItems(target.Cast(this).Reader); 33 | public override void Dump(VM vm, Value value, StringBuilder result) => result.Append($"(Pipe {vm.GetObjectId(value.Cast(this))})"); 34 | public Task Poll(Value target, CancellationToken ct) => 35 | target.Cast(this).Reader.WaitToReadAsync(ct).AsTask(); 36 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/PollTrait.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public interface PollTrait 4 | { 5 | Task Poll(Value target, CancellationToken ct); 6 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Port.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Iters.Core; 2 | using System.Text; 3 | 4 | namespace Sharpl.Types.Core; 5 | 6 | public class PortType(string name, AnyType[] parents) : Type(name, parents), CloseTrait, IterTrait, PollTrait 7 | { 8 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 9 | { 10 | var t = target.Cast(this, loc); 11 | 12 | switch (arity) 13 | { 14 | case 0: 15 | stack.Push(Task.Run(async () => await t.Read(vm, loc)).Result ?? Value._); 16 | break; 17 | case 1: 18 | var v = stack.Pop(); 19 | Task.Run(async () => await t.Write(v, vm, loc)); 20 | break; 21 | default: 22 | throw new EvalError("Invalid arguments", loc); 23 | } 24 | } 25 | 26 | public void Close(Value target) => target.Cast(this).Close(); 27 | 28 | public Iter CreateIter(Value target, VM vm, Loc loc) => new PortItems(target.Cast(this)); 29 | public override void Dump(VM vm, Value value, StringBuilder result) => result.Append($"(Port {vm.GetObjectId(value.Cast(this))})"); 30 | public Task Poll(Value target, CancellationToken ct) => target.Cast(this).Poll(ct); 31 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/RangeTrait.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public interface RangeTrait 4 | { 5 | Iter CreateRange(Value min, Value max, Value stride, Loc loc); 6 | }; -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/StackTrait.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public interface StackTrait 4 | { 5 | Value Peek(Loc loc, VM vm, Value srcVal); 6 | Value Pop(Loc loc, VM vm, Register src, Value srcVal); 7 | void Push(Loc loc, VM vm, Register dst, Value dstVal, Value val); 8 | }; -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/String.cs: -------------------------------------------------------------------------------- 1 | 2 | namespace Sharpl.Types.Core; 3 | 4 | using System.Text; 5 | 6 | public class StringType(string name, AnyType[] parents) : 7 | ComparableType(name, parents), IterTrait, LengthTrait, StackTrait 8 | { 9 | static string Escape(string value) => value 10 | .Replace("\"", "\\\"") 11 | .Replace("\r", "\\r") 12 | .Replace("\n", "\\n"); 13 | 14 | public override bool Bool(Value value) => value.Cast(this).Length != 0; 15 | 16 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 17 | { 18 | stack.Reverse(arity); 19 | var res = new StringBuilder(); 20 | 21 | while (arity > 0) 22 | { 23 | stack.Pop().Say(vm, res); 24 | arity--; 25 | } 26 | 27 | stack.Push(Value.Make(this, res.ToString())); 28 | } 29 | 30 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 31 | { 32 | switch (arity) 33 | { 34 | case 1: 35 | { 36 | var iv = stack.Pop(); 37 | var t = target.Cast(this); 38 | 39 | if (iv.Type == Libs.Core.Pair) 40 | { 41 | var p = iv.CastUnbox(Libs.Core.Pair); 42 | var i = (p.Item1.Type == Libs.Core.Nil) ? 0 : p.Item1.CastUnbox(Libs.Core.Int, loc); 43 | var n = (p.Item2.Type == Libs.Core.Nil) ? t.Length - i : p.Item2.CastUnbox(Libs.Core.Int, loc); 44 | stack.Push(Libs.Core.String, t[i..(i + n)]); 45 | } 46 | else 47 | { 48 | var i = iv.CastUnbox(Libs.Core.Int, loc); 49 | stack.Push(Libs.Core.Char, t[i]); 50 | } 51 | 52 | break; 53 | } 54 | case 2: 55 | { 56 | var v = stack.Pop().CastUnbox(Libs.Core.Char, loc); 57 | var s = target.Cast(this); 58 | var cs = s.ToCharArray(); 59 | var i = stack.Pop().CastUnbox(Libs.Core.Int, loc); 60 | cs[i] = v; 61 | break; 62 | } 63 | default: 64 | throw new EvalError($"Wrong number of arguments: {arity}", loc); 65 | 66 | } 67 | } 68 | 69 | public Iter CreateIter(Value target, VM vm, Loc loc) => 70 | new Iters.Core.EnumeratorItems(target.Cast(this).Select(c => Value.Make(Libs.Core.Char, c)).GetEnumerator()); 71 | 72 | public override void Dump(VM vm, Value value, StringBuilder result) => 73 | result.Append($"\"{Escape(value.Cast(this))}\""); 74 | 75 | public int Length(Value target) => target.Cast(this).Length; 76 | 77 | public Value Peek(Loc loc, VM vm, Value srcVal) 78 | { 79 | var src = srcVal.Cast(this); 80 | return (src.Length == 0) ? Value._ : Value.Make(Libs.Core.Char, src[^1]); 81 | } 82 | 83 | public Value Pop(Loc loc, VM vm, Register src, Value srcVal) 84 | { 85 | var sv = srcVal.Cast(this); 86 | if (sv.Length == 0) { return Value._; } 87 | var c = sv[^1]; 88 | vm.Set(src, Value.Make(this, sv[0..^1])); 89 | return Value.Make(Libs.Core.Char, c); 90 | } 91 | 92 | public void Push(Loc loc, VM vm, Register dst, Value dstVal, Value val) => 93 | vm.Set(dst, Value.Make(this, dstVal.Cast(this) + val.CastUnbox(Libs.Core.Char))); 94 | 95 | public override void Say(VM vm, Value value, StringBuilder result) => result.Append(value.Data); 96 | 97 | public override string ToJson(Value value, Loc loc) => $"\"{Escape(value.Cast(this))}\""; 98 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Sym.cs: -------------------------------------------------------------------------------- 1 | 2 | using Sharpl.Forms; 3 | using System.Text; 4 | 5 | namespace Sharpl.Types.Core; 6 | 7 | public class SymType(string name, AnyType[] parents) : 8 | Type(name, parents), ComparableTrait 9 | { 10 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 11 | { 12 | stack.Reverse(arity); 13 | var res = new StringBuilder(); 14 | 15 | while (arity > 0) 16 | { 17 | stack.Pop().Say(vm, res); 18 | arity--; 19 | } 20 | 21 | stack.Push(Value.Make(this, vm.Intern(res.ToString()))); 22 | } 23 | 24 | public Order Compare(Value left, Value right) 25 | { 26 | var lv = left.Cast(this); 27 | var rv = right.Cast(this); 28 | return ComparableTrait.IntOrder(lv.Name.CompareTo(rv.Name)); 29 | } 30 | 31 | public override bool Equals(Value left, Value right) => left.Cast(this) == right.Cast(this); 32 | public override void Say(VM vm, Value value, StringBuilder result) => result.Append(value.Cast(this).Name); 33 | public override string ToJson(Value value, Loc loc) => $"\"{value.Cast(this).Name}\""; 34 | 35 | public override Form Unquote(VM vm, Value value, Loc loc) 36 | { 37 | var id = value.Cast(this).Name; 38 | var v = vm.Env[id]; 39 | if (v is null) { throw new EmitError("Missing unquoted value", loc); } 40 | return new Literal((Value)v, loc); 41 | } 42 | } 43 | -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Timestamp.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class TimestampType(string name, AnyType[] parents) : 6 | ComparableType(name, parents), NumericTrait, RangeTrait 7 | { 8 | public void Add(VM vm, Stack stack, int arity, Loc loc) 9 | { 10 | stack.Reverse(arity); 11 | var res = stack.Pop().CastUnbox(this); 12 | arity--; 13 | 14 | while (arity > 0) 15 | { 16 | res = stack.Pop().CastUnbox(Libs.Core.Duration, loc).AddTo(res); 17 | arity--; 18 | } 19 | 20 | stack.Push(this, res); 21 | } 22 | 23 | public override bool Bool(Value value) => value.CastUnbox(this).CompareTo(DateTime.MinValue) > 0; 24 | 25 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 26 | { 27 | int y = 1, M = 1, d = 1, h = 0, m = 0, s = 0, ms = 0, us = 0; 28 | 29 | var get = (int dv) => 30 | { 31 | var v = stack.Pop(); 32 | return (v.Type == Libs.Core.Nil) ? dv : v.CastUnbox(Libs.Core.Int, loc); 33 | }; 34 | 35 | if (arity > 7) { us = get(us); } 36 | if (arity > 6) { ms = get(ms); } 37 | if (arity > 5) { s = get(s); } 38 | if (arity > 4) { m = get(m); } 39 | if (arity > 3) { h = get(h); } 40 | if (arity > 2) { d = get(d); } 41 | if (arity > 1) { M = get(M); } 42 | if (arity > 0) { y = get(y); } 43 | stack.Push(Libs.Core.Timestamp, new DateTime(y, M, d, h, m, s, ms, us)); 44 | } 45 | 46 | public Iter CreateRange(Value min, Value max, Value stride, Loc loc) 47 | { 48 | DateTime minVal = (min.Type == Libs.Core.Nil) ? DateTime.MinValue : min.CastUnbox(this, loc); 49 | DateTime maxVal = (max.Type == Libs.Core.Nil) ? DateTime.MaxValue : max.CastUnbox(this, loc); 50 | 51 | Duration? strideVal = (stride.Type == Libs.Core.Nil) 52 | ? (maxVal is DateTime mv 53 | ? new Duration(0, TimeSpan.FromDays((mv.CompareTo(minVal) < 0) ? -1 : 1)) 54 | : null) 55 | : stride.CastUnbox(Libs.Core.Duration, loc); 56 | 57 | if (strideVal is null) { throw new EvalError("Missing stride", loc); } 58 | return new Iters.Core.TimeRange(minVal, maxVal, (Duration)strideVal); 59 | } 60 | 61 | public void Divide(VM vm, Stack stack, int arity, Loc loc) => 62 | throw new EvalError("Not supported", loc); 63 | 64 | public void Multiply(VM vm, Stack stack, int arity, Loc loc) => 65 | throw new EvalError("Not supported", loc); 66 | 67 | public void Subtract(VM vm, Stack stack, int arity, Loc loc) 68 | { 69 | if (arity == 1) { throw new EvalError("Not supported", loc); } 70 | else if (arity == 2 && stack.Peek().Type == Libs.Core.Timestamp) 71 | { 72 | var y = stack.Pop().CastUnbox(this); 73 | var x = stack.Pop().CastUnbox(this); 74 | stack.Push(Libs.Core.Duration, new Duration(0, x.Subtract(y))); 75 | } 76 | else 77 | { 78 | stack.Reverse(arity); 79 | var res = stack.Pop().CastUnbox(this); 80 | arity--; 81 | 82 | while (arity > 0) 83 | { 84 | res = stack.Pop().CastUnbox(Libs.Core.Duration, loc).SubtractFrom(res); 85 | arity--; 86 | } 87 | 88 | stack.Push(this, res); 89 | } 90 | } 91 | 92 | public override void Dump(VM vm, Value value, StringBuilder result) => result.Append($"{value.CastUnbox(this):yyyy-MM-dd HH:mm:ss}"); 93 | 94 | public override string ToJson(Value value, Loc loc) => $"{value.CastUnbox(this):yyyy-MM-ddTHH:mm:ss.fffZ}"; 95 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/Trait.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class TraitType(string name, AnyType[] parents) : ComparableType(name, parents) 6 | { 7 | public override void Dump(VM vm, Value value, StringBuilder result) 8 | { 9 | var t = value.Cast(this); 10 | result.Append($"(trait {t.Name} [{string.Join(' ', t.Parents.Where(pt => pt != t).Select(pt => pt.Name).ToArray())}])"); 11 | } 12 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/UserMethod.cs: -------------------------------------------------------------------------------- 1 | namespace Sharpl.Types.Core; 2 | 3 | public class UserMethodType(string name, AnyType[] parents) : Type(name, parents) 4 | { 5 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) 6 | { 7 | var startPC = vm.PC; 8 | var m = target.Cast(this); 9 | vm.CallUserMethod(loc, stack, m, new Value?[m.Args.Length], arity, registerCount); 10 | if (eval) 11 | { 12 | vm.EvalUntil(startPC, stack); 13 | vm.PC--; 14 | } 15 | } 16 | 17 | public override void EmitCall(VM vm, Value target, Form.Queue args, Loc loc) 18 | { 19 | var m = target.Cast(this); 20 | var arity = args.Count; 21 | var splat = args.IsSplat; 22 | if (!splat && arity < m.MinArgCount) { throw new EmitError($"Not enough arguments: {m}", loc); } 23 | if (splat) { vm.Emit(Ops.PushSplat.Make()); } 24 | var argMask = new Value?[Math.Max(arity, m.Args.Length)]; 25 | var i = 0; 26 | 27 | foreach (var a in args) 28 | { 29 | if (a.GetValue(vm) is Value av) 30 | { 31 | if (av.Type == Libs.Core.Binding) 32 | { 33 | var r = av.CastUnbox(Libs.Core.Binding); 34 | av = Value.Make(Libs.Core.Binding, new Register(r.FrameOffset + 1, r.Index)); 35 | } 36 | 37 | while (i < m.Args.Length && m.Args[i].Unzip) 38 | { 39 | var p = av.CastUnbox(Libs.Core.Pair, loc); 40 | argMask[i] = p.Item1; 41 | i++; 42 | av = p.Item2; 43 | } 44 | 45 | argMask[i] = av; 46 | } 47 | else 48 | { 49 | vm.Emit(a); 50 | var f = a; 51 | 52 | while (i < m.Args.Length && m.Args[i].Unzip) { 53 | if (f is Forms.Pair pf) 54 | { 55 | f = pf.Right; 56 | vm.Emit(Ops.Unzip.Make(loc)); 57 | i++; 58 | } 59 | else 60 | { 61 | throw new EmitError($"Expected pair: {f}", loc); 62 | } 63 | } 64 | } 65 | 66 | i++; 67 | } 68 | 69 | args.Clear(); 70 | vm.Emit(Ops.CallUserMethod.Make(m, argMask, splat, vm.NextRegisterIndex, loc)); 71 | } 72 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Core/UserType.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Core; 4 | 5 | public class UserType : Type 6 | { 7 | private readonly Value cons; 8 | private readonly AnyType type; 9 | 10 | public UserType(string name, AnyType[] parents, Value cons) : base(name, parents) { 11 | this.cons = cons; 12 | type = parents.First(pt => pt is not UserTrait); 13 | } 14 | 15 | public override void Call(VM vm, Stack stack, int arity, Loc loc) 16 | { 17 | stack.Reverse(arity); 18 | cons.Call(vm, stack, arity, vm.NextRegisterIndex, true, loc); 19 | if (stack.TryPop(out var v)) { stack.Push(this, v.Data); } 20 | else throw new EvalError("Constructor didn't return a value", loc); 21 | } 22 | 23 | public override void Call(VM vm, Stack stack, Value target, int arity, int registerCount, bool eval, Loc loc) => 24 | type.Call(vm, stack, target, arity, registerCount, eval, loc); 25 | 26 | public override void Dump(VM vm, Value value, StringBuilder result) 27 | { 28 | result.Append($"({Name} "); 29 | type.Dump(vm, value, result); 30 | result.Append(')'); 31 | } 32 | public override void Say(VM vm, Value value, StringBuilder result) => 33 | type.Say(vm, value, result); 34 | } 35 | -------------------------------------------------------------------------------- /src/Sharpl/Types/IO/InputStream.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Iters.IO; 2 | using Sharpl.Types.Core; 3 | using System.Text; 4 | 5 | namespace Sharpl.Types.IO; 6 | 7 | public class InputStreamType(string name, AnyType[] parents) : 8 | Type(name, parents), IterTrait 9 | { 10 | public override void Dump(VM vm, Value value, StringBuilder result) => 11 | result.Append($"(InputStream {vm.GetObjectId(value.Cast(this))})"); 12 | public Iter CreateIter(Value target, VM vm, Loc loc) => new StreamLines(target.Cast(this)); 13 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Net/Server.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Iters.Core; 2 | using Sharpl.Types.Core; 3 | using System.Net.Sockets; 4 | using System.Text; 5 | using System.Threading.Channels; 6 | 7 | namespace Sharpl.Types.Net; 8 | 9 | public class ServerType(string name, AnyType[] parents) : 10 | Type(name, parents), CloseTrait, IterTrait 11 | { 12 | public void Close(Value target) => target.Cast(this).Stop(); 13 | 14 | public Iter CreateIter(Value target, VM vm, Loc loc) 15 | { 16 | var s = target.Cast(this); 17 | var c = Channel.CreateUnbounded(); 18 | 19 | Task.Run(async () => 20 | { 21 | while (await s.AcceptTcpClientAsync() is TcpClient tc) 22 | { 23 | await c.Writer.WriteAsync(Value.Make(Libs.Net.Stream, tc.GetStream())); 24 | } 25 | }); 26 | 27 | return new PipeItems(c); 28 | } 29 | 30 | public override void Dump(VM vm, Value value, StringBuilder result) => 31 | result.Append($"(net/Server {vm.GetObjectId(value.Cast(this))})"); 32 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Net/Stream.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Types.Core; 2 | using System.Net.Sockets; 3 | using System.Text; 4 | 5 | namespace Sharpl.Types.Net; 6 | 7 | public class StreamType(string name, AnyType[] parents) : Type(name, parents), CloseTrait 8 | { 9 | public void Close(Value target) => target.Cast(this).Close(); 10 | public override void Dump(VM vm, Value value, StringBuilder result) => 11 | result.Append($"(net/Stream {vm.GetObjectId(value.Cast(this))})"); 12 | } -------------------------------------------------------------------------------- /src/Sharpl/Types/Term/Key.cs: -------------------------------------------------------------------------------- 1 | using System.Text; 2 | 3 | namespace Sharpl.Types.Term; 4 | 5 | public class KeyType(string name, AnyType[] parents) : Type(name, parents) 6 | { 7 | public override void Dump(VM vm, Value value, StringBuilder result) 8 | { 9 | result.Append("(term/Key "); 10 | Say(vm, value, result); 11 | result.Append(')'); 12 | } 13 | 14 | public override void Say(VM vm, Value value, StringBuilder result) 15 | { 16 | var ki = value.CastUnbox(this); 17 | if ((ki.Modifiers & ConsoleModifiers.Alt) != 0) { result.Append("Alt+"); } 18 | if ((ki.Modifiers & ConsoleModifiers.Control) != 0) { result.Append("Ctrl+"); } 19 | if ((ki.Modifiers & ConsoleModifiers.Shift) != 0) { result.Append("Shift+"); } 20 | result.Append(ki.Key.ToString()); 21 | } 22 | } 23 | -------------------------------------------------------------------------------- /src/Sharpl/UserMethod.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Libs; 2 | using System.Data; 3 | using System.Text; 4 | 5 | namespace Sharpl; 6 | 7 | public class UserMethod 8 | { 9 | public record struct Arg(string Name, int RegisterIndex = -1, bool Unzip = false) { } 10 | 11 | public static void Bind(VM vm, Form f, List fas, bool unzip = false) 12 | { 13 | switch (f) 14 | { 15 | case Forms.Id id: 16 | { 17 | var r = vm.AllocRegister(); 18 | vm.Env.Bind(id.Name, Value.Make(Core.Binding, new Register(0, r))); 19 | fas.Add(new Arg(id.Name, r, unzip)); 20 | break; 21 | } 22 | case Forms.Nil: 23 | fas.Add(new Arg("_", -1, unzip)); 24 | break; 25 | case Forms.Pair p: 26 | Bind(vm, p.Left, fas, unzip = true); 27 | Bind(vm, p.Right, fas); 28 | break; 29 | } 30 | } 31 | 32 | public readonly Arg[] Args; 33 | public readonly int MinArgCount; 34 | public readonly (string, int, Register)[] Closure; 35 | public readonly Dictionary ClosureValues = new Dictionary(); 36 | public readonly Loc Loc; 37 | public readonly string Name; 38 | public int? StartPC; 39 | public int? EndPC; 40 | public readonly bool Vararg; 41 | 42 | public UserMethod(VM vm, string name, string[] ids, Arg[] args, bool vararg, Loc loc) 43 | { 44 | Loc = loc; 45 | Name = name; 46 | 47 | Closure = ids.AsEnumerable().Select(id => 48 | { 49 | #pragma warning disable CS8629 50 | var b = ((Value)vm.Env[id]).CastUnbox(Core.Binding); 51 | #pragma warning restore CS8629 52 | var r = vm.AllocRegister(); 53 | vm.Env[id] = Value.Make(Core.Binding, new Register(0, r)); 54 | return (id, r, b); 55 | }).ToArray(); 56 | 57 | Args = args; 58 | MinArgCount = args[0..(vararg ? ^1 : ^0)].Count((a) => !a.Name.EndsWith('?') && !a.Unzip); 59 | Vararg = vararg; 60 | } 61 | 62 | public void BindArgs(VM vm, Value?[] argMask, int arity, Stack stack) 63 | { 64 | for (var i = Args.Length - 1; i >= 0; i--) 65 | { 66 | if (i >= argMask.Length) { break; } 67 | var ar = Args[i].RegisterIndex; 68 | 69 | if (Vararg && i == Args.Length - 1) 70 | { 71 | var n = arity - Args.Length + 1; 72 | var vs = new Value[n]; 73 | 74 | for (var j = n - 1; j >= 0; j--) 75 | { 76 | vs[j] = (argMask.Length > i + j && argMask[i + j] is Value v) ? v : stack.Pop(); 77 | } 78 | 79 | if (ar != -1) { vm.SetRegister(0, ar, Value.Make(Core.Array, vs)); } 80 | } 81 | else 82 | { 83 | if (argMask[i] is Value v) 84 | { 85 | if (v.Type == Core.Binding) 86 | { 87 | var r = v.CastUnbox(Core.Binding); 88 | if (r.FrameOffset != 0 || r.Index != ar) { vm.SetRegister(0, ar, vm.Get(r)); } 89 | } 90 | else if (ar != -1) { vm.SetRegister(0, ar, v.Copy()); } 91 | } 92 | else { 93 | v = stack.Pop(); 94 | if (ar != -1) { vm.SetRegister(0, ar, v); } 95 | } 96 | } 97 | } 98 | 99 | foreach (var (r, v) in ClosureValues) { vm.SetRegister(0, r, v); } 100 | } 101 | 102 | public override string ToString() 103 | { 104 | var result = new StringBuilder(); 105 | result.Append($"(^{Name} ["); 106 | 107 | for (var i = 0; i < Args.Length; i++) 108 | { 109 | if (i > 0) { result.Append(' '); } 110 | result.Append(Args[i].Name); 111 | } 112 | 113 | if (Vararg) { result.Append('*'); } 114 | result.Append("])"); 115 | return result.ToString(); 116 | } 117 | } 118 | 119 | -------------------------------------------------------------------------------- /src/Sharpl/Value.cs: -------------------------------------------------------------------------------- 1 | using Sharpl.Types.Core; 2 | using System.Diagnostics; 3 | using System.Diagnostics.CodeAnalysis; 4 | using System.Runtime.CompilerServices; 5 | using System.Text; 6 | 7 | namespace Sharpl; 8 | 9 | public readonly record struct Value(AnyType Type, object Data) : IComparable 10 | { 11 | public static explicit operator bool(Value v) => v.Type.Bool(v); 12 | public static Value Make(Type type, T data) where T : notnull => new Value(type, data); 13 | 14 | public static readonly Value _ = Make(Libs.Core.Nil, false); 15 | public static readonly Value F = Make(Libs.Core.Bit, false); 16 | public static readonly Value T = Make(Libs.Core.Bit, true); 17 | 18 | public void Call(VM vm, Stack stack, int arity, int registerCount, bool eval, Loc loc) => 19 | Type.Call(vm, stack, this, arity, registerCount, eval, loc); 20 | 21 | // Please do not remove the type checks below. 22 | // These methods provide slightly more optimal type check and cast path 23 | // as compared to regular cast operators. The reason for this is that 24 | // Sharpl has its own type system abstraction which upholds type safety 25 | // guarantees, therefore we can avoid double-checking whether the type is 26 | // correct. However, if the type comparisons below are removed, this will 27 | // make the code below very unsafe by reinterpreting structs and classes 28 | // as arbitrary types which will can lead to memory corruption and crashes. 29 | public T Cast(Type type) where T : class => 30 | (Type.Cast>() is Type) ? Unsafe.As(Data) : TypeMismatch(Type, type); 31 | 32 | public T Cast(Type type, Loc loc) where T : class => 33 | (Type.Cast>() is Type) ? Unsafe.As(Data) : TypeMismatch(loc, Type, type); 34 | 35 | public T CastUnbox(Type type) where T : struct => 36 | (Type.Cast>() is Type) ? Unsafe.As>(Data).Value : TypeMismatch(Type, type); 37 | 38 | public T CastUnbox(Type type, Loc loc) where T : struct => 39 | (Type.Cast>() is Type) ? Unsafe.As>(Data).Value : TypeMismatch(loc, Type, type); 40 | 41 | // Do not remove Nullable overloads - they are necessary 42 | // to correctly handle unboxing of nullable structs. 43 | public T? CastUnbox(Type type) where T : struct => (T?)Data; 44 | 45 | public T? CastUnbox(Type type, Loc loc) where T : struct => 46 | (Type.Cast>() is Type) ? (T?)Data : TypeMismatch(loc, Type, type); 47 | 48 | public T CastSlow(Type type) => (T)Data; 49 | 50 | public int CompareTo(Value other) 51 | { 52 | if (other.Type != Type) { return Type.Name.CompareTo(other.Type.Name); } 53 | if (Type is ComparableTrait ct) 54 | { return ComparableTrait.OrderInt(ct.Compare(this, other)); } 55 | throw new Exception("Not comparable"); 56 | } 57 | 58 | public Value Copy() => Type.Copy(this); 59 | public void Dump(VM vm, StringBuilder result) => Type.Dump(vm, this, result); 60 | 61 | public string Dump(VM vm) 62 | { 63 | var res = new StringBuilder(); 64 | Dump(vm, res); 65 | return res.ToString(); 66 | } 67 | 68 | public void Emit(VM vm, Form.Queue args, Loc loc) => Type.Emit(vm, this, args, loc); 69 | public void EmitCall(VM vm, Form.Queue args, Loc loc) => Type.EmitCall(vm, this, args, loc); 70 | public bool Equals(Value other) => Type == other.Type && Type.Equals(this, other); 71 | public override int GetHashCode() => Data.GetHashCode(); 72 | 73 | public bool Isa(AnyType parent) => Type.Isa(parent); 74 | public void Say(VM vm, StringBuilder result) => Type.Say(vm, this, result); 75 | 76 | public string Say(VM vm) 77 | { 78 | var result = new StringBuilder(); 79 | Say(vm, result); 80 | return result.ToString(); 81 | } 82 | 83 | public string ToJson(Loc loc) => Type.ToJson(this, loc); 84 | 85 | public T? TryCastUnbox(Type type) where T : struct => 86 | Type == type ? Unsafe.Unbox(Data) : default(T?); 87 | 88 | public Form Unquote(VM vm, Loc loc) => Type.Unquote(vm, this, loc); 89 | 90 | [DoesNotReturn, StackTraceHidden] 91 | static T TypeMismatch(AnyType lhs, Type rhs) => 92 | throw new InvalidCastException($"Type mismatch: {lhs}/{rhs}"); 93 | 94 | [DoesNotReturn, StackTraceHidden] 95 | static T TypeMismatch(Loc loc, AnyType lhs, Type rhs) => 96 | throw new EvalError($"Type mismatch: {lhs}/{rhs}", loc); 97 | } -------------------------------------------------------------------------------- /tests/all-tests.sl: -------------------------------------------------------------------------------- 1 | (check 42 2 | 42) 3 | 4 | (check 42 5 | (do 42)) 6 | 7 | (check 42 8 | (let [x 42] 9 | x)) 10 | 11 | (check 42 12 | (let [foo 35] 13 | (let [bar (+ foo 7)] 14 | bar))) 15 | 16 | (check 3:4 17 | (let [foo 1 bar 2] 18 | (set foo 3 bar 4) 19 | foo:bar)) 20 | 21 | (check 42 22 | (let [foo 35]) 23 | (var foo 42) 24 | foo) 25 | 26 | (check 42 27 | (var foo 42) 28 | foo) 29 | 30 | (check 35 31 | (var foo 35) 32 | 33 | (^bar [] 34 | foo) 35 | 36 | (let [foo (+ foo 7)] 37 | (check 42 38 | (bar))) 39 | 40 | (bar)) 41 | 42 | (check 42:2 43 | (parse-int "42foo")) 44 | 45 | (check (= (emit '(+ 1 2)) (eval '(+ 1 2)))) 46 | 47 | (check 2 48 | (let [x 1] 49 | (inc x))) 50 | 51 | (check 3 52 | (let [x 1] 53 | (inc x 2))) 54 | 55 | (check 1 56 | (let [x 2] 57 | (dec x))) 58 | 59 | (check 1 60 | (let [x 3] 61 | (dec x 2))) 62 | 63 | (check 1 64 | (min 3 1 2)) 65 | 66 | (check 3 67 | (max 1 3 2)) 68 | 69 | (check 0 70 | (rand-int 1)) 71 | 72 | (check F 73 | (is (rand-int) (rand-int))) 74 | 75 | (check (is (type-of 42) Int)) 76 | (check (isa 42 Int)) 77 | (check (not (isa 'foo Int))) 78 | 79 | (load "array-tests.sl") 80 | (load "bind-tests.sl") 81 | (load "char-tests.sl") 82 | (load "defer-tests.sl") 83 | (load "error-tests.sl") 84 | (load "fib-tests.sl") 85 | (load "fix-tests.sl") 86 | (load "int-tests.sl") 87 | (load "io-tests.sl") 88 | (load "iter-tests.sl") 89 | (load "json-tests.sl") 90 | (load "lib-tests.sl") 91 | (load "list-tests.sl") 92 | (load "logic-tests.sl") 93 | (load "loop-tests.sl") 94 | (load "map-tests.sl") 95 | (load "method-tests.sl") 96 | (load "pair-tests.sl") 97 | (load "pipe-tests.sl") 98 | (load "quote-tests.sl") 99 | (load "string-tests.sl") 100 | (load "time-tests.sl") 101 | (load "thread-tests.sl") 102 | (load "type-tests.sl") 103 | 104 | (load "../examples/aoc23/code1-1.sl") 105 | (load "../examples/aoc23/code2-1.sl") -------------------------------------------------------------------------------- /tests/array-tests.sl: -------------------------------------------------------------------------------- 1 | (check [] 2 | [[[]*]*]) 3 | 4 | (check [42] 5 | [[[42]*]*]) 6 | 7 | (check 42 8 | (- [43 1]*)) 9 | 10 | (check [1 4 3] 11 | (let [foo [1 2 3]] 12 | (foo 1 4) 13 | foo)) 14 | 15 | (check [1 2 3 4 5] 16 | [1 2 [3 4]* 5]) 17 | 18 | (check F 19 | (is [1 2 3] [1 2 3])) 20 | 21 | (check 2 22 | (let [x [1 2 3]] 23 | (x 1))) 24 | 25 | (check [1 4 3] 26 | (let [x [1 2 3]] 27 | (x 1 4) 28 | x)) 29 | 30 | (check [2 3] 31 | ([1 2 3 4] 1:2)) 32 | 33 | (check [2 3] 34 | ([1 2 3] 1:_)) 35 | 36 | (check [1 2] 37 | (let [foo [1]] 38 | (push foo 2) 39 | foo)) 40 | 41 | (check 3 42 | (peek [1 2 3])) 43 | 44 | (check 3:[1 2] 45 | (let [foo [1 2 3]] 46 | (pop foo):foo)) 47 | 48 | (check 3 49 | #[1 2 3]) 50 | 51 | (check [_ _] 52 | (resize [] 2)) 53 | 54 | (check [42 42] 55 | (resize [] 2 42)) -------------------------------------------------------------------------------- /tests/bind-tests.sl: -------------------------------------------------------------------------------- 1 | (check 2:1 2 | (var r:l 1:2) 3 | l:r) 4 | 5 | (check 2:3 6 | (var _:r:rr 1:2:3) 7 | r:rr) 8 | 9 | (check 2:1 10 | (let [r:l 1:2] l:r)) 11 | 12 | (check 2:3 13 | (let [_:r:rr 1:2:3] r:rr)) -------------------------------------------------------------------------------- /tests/char-tests.sl: -------------------------------------------------------------------------------- 1 | (check (char/is-digit \0)) 2 | (check F (char/is-digit \a)) 3 | (check 7 (char/digit \7)) 4 | 5 | (check (\a \a)) 6 | (check (not (\a \b))) 7 | 8 | (check (= (char/up \a) \A)) 9 | (check (= (char/down \Z) \z)) 10 | -------------------------------------------------------------------------------- /tests/defer-tests.sl: -------------------------------------------------------------------------------- 1 | (check 3 2 | (var foo 1) 3 | 4 | (do 5 | (defer (^[] (set foo 3))) 6 | (set foo 2)) 7 | 8 | foo) 9 | 10 | (check 2 11 | (var foo 1) 12 | 13 | (do 14 | (defer (^[] 15 | (check (is foo 3)) 16 | (set foo 2))) 17 | 18 | (defer (^[] 19 | (check (is foo 4)) 20 | (set foo 3))) 21 | (set foo 4)) 22 | 23 | foo) -------------------------------------------------------------------------------- /tests/error-tests.sl: -------------------------------------------------------------------------------- 1 | (check "bummer" 2 | (try [Any:(^[e] e)] 3 | (fail _ 'bummer))) 4 | 5 | (do 6 | (trait Foo) 7 | 8 | (data Bar [Pair Foo] 9 | (^[x y z] x:y:z)) 10 | 11 | (check (Bar 1 2 3) 12 | (try [Foo:(^[e] e)] 13 | (fail Bar 3 2 1)))) 14 | 15 | (check 'caught 16 | (try [_:(^[_] 'caught)] (+ 'foo))) 17 | -------------------------------------------------------------------------------- /tests/fib-tests.sl: -------------------------------------------------------------------------------- 1 | (load "../fib.sl") 2 | 3 | (check 55 4 | (fib-rec 10)) 5 | 6 | (check 55 7 | (fib-tail 10 0 1)) 8 | 9 | (check 55 10 | (fib-list 10 (List 0))) 11 | 12 | (check 2971215073 13 | (fib-list 47 (List 0))) 14 | 15 | (check 55 16 | (fib-map 10 {})) 17 | 18 | (check 2971215073 19 | (fib-map 47 {})) -------------------------------------------------------------------------------- /tests/fix-tests.sl: -------------------------------------------------------------------------------- 1 | (check 1.23 2 | (Fix 2 123)) 3 | 4 | (check 1.5 5 | (+ 1.25 .25)) 6 | 7 | (check (- 1.23) 8 | (Fix 2 (- 123))) 9 | 10 | (check 1.25 11 | (- 1.5 .25)) 12 | 13 | (check [1.0 1.5 2.0] 14 | [(range 1.0 2.5 .5)*]) 15 | 16 | (check 5.0 17 | (* 2.5 2.0)) 18 | 19 | (check 2.5 20 | (/ 5.0 2.0)) 21 | 22 | (check 2 23 | (fix/to-int 2.5)) -------------------------------------------------------------------------------- /tests/input.txt: -------------------------------------------------------------------------------- 1 | foo 2 | bar 3 | baz -------------------------------------------------------------------------------- /tests/int-tests.sl: -------------------------------------------------------------------------------- 1 | (check (= 42 42)) 2 | 3 | (check (< 1 2 3)) 4 | 5 | (check F 6 | (< 1 3 2)) 7 | 8 | (check 42 9 | (let [foo 43] 10 | (dec foo))) 11 | 12 | (check 3 13 | (+ 1 2)) 14 | 15 | (check 2 16 | (- 3 1)) 17 | 18 | (check (- 2) 19 | (- 1 3)) 20 | 21 | (check 42 22 | (* 7 6)) 23 | 24 | (check 7 25 | (/ 42 6)) 26 | 27 | (check [1 2] 28 | [1..3*]) 29 | 30 | (check 2 31 | (1 [1 2 3])) -------------------------------------------------------------------------------- /tests/io-tests.sl: -------------------------------------------------------------------------------- 1 | (check ["foo" "bar" "baz"] 2 | (io/do-read [in "input.txt"] 3 | [(io/lines in)*])) -------------------------------------------------------------------------------- /tests/iter-tests.sl: -------------------------------------------------------------------------------- 1 | (check [] 2 | [_*]) 3 | 4 | (check ['foo:1 'bar:2 'baz:3]) 5 | [(map Pair '[foo bar baz] [1 2 3 4])*]) 6 | 7 | (check 1 8 | (reduce - [2 3] 0)) 9 | 10 | (check 6 11 | (reduce + (range _ 4) 0)) 12 | 13 | (check 5:2 14 | (find-first (^[x] (> x 3)) [1 3 5 7 9])) 15 | 16 | (check \;:3 17 | (find-first (^[c] (is c \;)) "abc;def")) 18 | 19 | (check ['foo:1:T 'bar:2:F] 20 | [(zip '[foo bar] '[1 2 3] [T F])*]) 21 | 22 | (check [42:'foo 43:'bar] 23 | [(enumerate 42 '[foo bar])*]) 24 | 25 | (check [3 4 5] 26 | [(filter (^[x] (> x 2)) [1 2 3 4 5])*]) 27 | 28 | (check 10 29 | (sum 1 2 3)) -------------------------------------------------------------------------------- /tests/json-tests.sl: -------------------------------------------------------------------------------- 1 | (check (let [v {'foo:42 'bar:.5 'baz:"abc" 'qux:[T F _]}] 2 | (= (json/decode (json/encode v)) v))) -------------------------------------------------------------------------------- /tests/lib-tests.sl: -------------------------------------------------------------------------------- 1 | (load "lib.sl") 2 | 3 | (lib test 4 | (check test 5 | (lib)) 6 | 7 | (var bar (+ foo 7))) 8 | 9 | (check 42 10 | test/bar) 11 | 12 | (check user 13 | (lib)) -------------------------------------------------------------------------------- /tests/lib.sl: -------------------------------------------------------------------------------- 1 | (lib test) 2 | 3 | (check test 4 | (lib)) 5 | 6 | (var foo 35) -------------------------------------------------------------------------------- /tests/list-tests.sl: -------------------------------------------------------------------------------- 1 | (check (List 1 2 3) 2 | (let [foo (List 1 2)] 3 | (push foo 3) 4 | foo)) 5 | 6 | (check 3 7 | (peek (List 1 2 3))) 8 | 9 | (check 3:(List 1 2) 10 | (let [foo (List 1 2 3)] 11 | (pop foo):foo)) 12 | 13 | (check (List 2 3) 14 | ((List 1 2 3 4) 1:2)) 15 | 16 | (check (List 2 3) 17 | ((List 1 2 3) 1:_)) 18 | 19 | (check 3 20 | #(List 1 2 3)) -------------------------------------------------------------------------------- /tests/logic-tests.sl: -------------------------------------------------------------------------------- 1 | (check 1 2 | 1 (if 0 2)) 3 | 4 | (check 2 5 | 1 (if 42 2)) 6 | 7 | (check 2 8 | (else 0 1 2)) 9 | 10 | (check 1 11 | (else 42 1 2)) 12 | 13 | (check 42 14 | (or F 42)) 15 | 16 | (check 0 17 | (or F 0)) 18 | 19 | (check (or T 42)) 20 | 21 | (check 42 22 | (and T 42)) 23 | 24 | (check 0 25 | (and 0 42)) -------------------------------------------------------------------------------- /tests/loop-tests.sl: -------------------------------------------------------------------------------- 1 | (check {1:4 2:5 3:6} 2 | (let [result {}] 3 | (for [i [1 2 3] 4 | j [4 5 6]] 5 | (result i j)) 6 | result)) 7 | 8 | (check (List 0 1 2) 9 | (^enumerate [n] 10 | (let [result (List) i 0] 11 | (loop 12 | (push result i) 13 | (if (is (inc i) n) (return result))))) 14 | 15 | (enumerate 3)) -------------------------------------------------------------------------------- /tests/map-tests.sl: -------------------------------------------------------------------------------- 1 | (check {'bar:2 'baz:3 'foo:1} 2 | {'foo:1 'bar:2 'baz:3}) 3 | 4 | (check {'bar:2 'baz:3 'foo:1} 5 | (Map ['foo:1 'bar:2 'baz:3]*)) 6 | 7 | (check [1:2 3:4] 8 | [{3:4 1:2}*]) 9 | 10 | (check {1:2 3:4} 11 | {[3:4 1:2]*}) 12 | 13 | (let [m1 '{foo:1 bar:2} m2 (Map m1*)] 14 | (check (not (is m1 m2))) 15 | (check (= m1 m2))) 16 | 17 | (check {'b:2 'c:3} 18 | ({'a:1 'b:2 'c:3 'd:4} 'b:'c)) 19 | 20 | (check {'b:2 'c:3} 21 | ({'a:1 'b:2 'c:3} 'b:_)) 22 | 23 | (check 1 24 | ('{a:1} 'a)) 25 | 26 | (check 3 27 | #'{a:1 b:2 c:3}) -------------------------------------------------------------------------------- /tests/method-tests.sl: -------------------------------------------------------------------------------- 1 | (check 42 2 | (^foo [x] 3 | x) 4 | 5 | (foo 42)) 6 | 7 | (check 42 8 | (^foo [a b c] 9 | (- a b c)) 10 | 11 | (foo 45 2 1)) 12 | 13 | (check 6 14 | (^foo [in out] 15 | (else (= in 0) out (foo (- in 1) (+ out in)))) 16 | 17 | (foo 3 0)) 18 | 19 | (check 42 20 | (let [f (^[x] x)] 21 | (f 42))) 22 | 23 | (check 2 24 | (^foo [] 25 | 2) 26 | 27 | (^bar [] 28 | 1 (return (foo)) 3) 29 | 30 | (bar)) 31 | 32 | (check 42 33 | (let [foo (let [bar 44] 34 | (^[] (dec bar)))] 35 | (foo) 36 | (foo))) 37 | 38 | (check 3 39 | (^foo [x] 40 | (+ x 1)) 41 | 42 | (^bar [x] 43 | (+ x 2)) 44 | 45 | (foo & bar 0)) 46 | 47 | (check 35 48 | (^foo [bar*] 49 | (- bar*)) 50 | 51 | (foo 42 7)) 52 | 53 | (check 1 54 | (^foo [] 1:2) 55 | (foo:_)) 56 | 57 | (check 2 58 | (^foo [] 1:2) 59 | (_:foo)) 60 | 61 | (check 2:1 62 | (^foo [l:r] r:l) 63 | (foo 1:2)) 64 | 65 | (check 2:3 66 | (^foo [_:r:rr] r:rr) 67 | (foo 1:2:3)) 68 | -------------------------------------------------------------------------------- /tests/pair-tests.sl: -------------------------------------------------------------------------------- 1 | (check (Bit F:F)) 2 | 3 | (check 3 (3:4 0)) 4 | (check 4 (3:4 1)) 5 | (check 3:4:5 (1:2:3:4:5 2)) 6 | 7 | (check 1:4:3 8 | (let [foo 1:2:3] 9 | (foo 1 4))) 10 | 11 | (check [1 2 3] 12 | [1:2:3*]) 13 | 14 | (check 1:2:3 15 | (Pair [1 2 3]*)) 16 | 17 | (check 3 18 | (length 1:2:3)) 19 | 20 | (check 1:2:3 21 | (let [foo 2:3] 22 | (push foo 1) 23 | foo)) 24 | 25 | (check 1 26 | (peek 1:2:3)) 27 | 28 | (check 1:[2:3] 29 | (let [foo 1:2:3] 30 | (pop foo):[foo])) -------------------------------------------------------------------------------- /tests/pipe-tests.sl: -------------------------------------------------------------------------------- 1 | (check 42 2 | (let [p1 (Pipe) p2 (Pipe)] 3 | (p2 42) 4 | ((poll [p1 p2])))) -------------------------------------------------------------------------------- /tests/quote-tests.sl: -------------------------------------------------------------------------------- 1 | (check 'foo42 2 | (Sym "foo" 42)) 3 | 4 | (check (= 'foo 'foo)) 5 | 6 | (check F (= 'foo 'bar)) 7 | 8 | (check F 9 | (= (gensym 'foo) (gensym 'foo))) 10 | 11 | (check ['foo 'bar 'baz] 12 | '[foo bar baz]) 13 | 14 | (check ['foo 42 'baz] 15 | (let [bar 42] 16 | '[foo ,bar baz])) 17 | 18 | (check ['foo 42 "abc" 'qux] 19 | (let [bar 42 20 | baz "abc"] 21 | '[foo ,[bar baz]* qux])) 22 | 23 | (check 3 24 | (eval '(+ 1 2))) 25 | 26 | (check '[foo 42 bar] 27 | (let [c '(+ 35 7)] 28 | '[foo ,c bar])) -------------------------------------------------------------------------------- /tests/string-tests.sl: -------------------------------------------------------------------------------- 1 | (check (is "abc" "abc")) 2 | 3 | (check "FOO" 4 | (string/up "Foo")) 5 | 6 | (check "foo" 7 | (string/down "Foo")) 8 | 9 | (check 3 10 | #"foo") 11 | 12 | (check "cba" 13 | (string/reverse "abc")) 14 | 15 | (check "bar" 16 | ("foobarbaz" 3:3)) 17 | 18 | (check "abc" 19 | (let [foo "ab"] 20 | (push foo \c) 21 | foo)) 22 | 23 | (check \c 24 | (peek "abc")) 25 | 26 | (check \c:"ab" 27 | (let [foo "abc"] 28 | (pop foo):foo)) 29 | 30 | (check "AbAAbbA" 31 | (string/replace "abaabba" "a" "A")) 32 | 33 | (check "foo-bar" 34 | (string/replace "foo bar" "(\w+)\s*(\w+)" "$1-$2")) 35 | 36 | (check ["foo" "bar"] 37 | (string/split "foo bar" " ")) 38 | 39 | (check "foobar" 40 | (string/strip ";foo;bar;" \;)) 41 | 42 | (check "foobar" 43 | (string/trim " foo bar ")) -------------------------------------------------------------------------------- /tests/thread-tests.sl: -------------------------------------------------------------------------------- 1 | (check 42 2 | (let [p (spawn [p] (p 42))] 3 | (p))) -------------------------------------------------------------------------------- /tests/time-tests.sl: -------------------------------------------------------------------------------- 1 | (let [t (Timestamp 2024 9 16 21 22 23)] 2 | (check (is (time/Y t) 2024)) 3 | (check (is (time/M t) 9)) 4 | (check (is (time/D t) 16)) 5 | (check (is (time/h t) 21)) 6 | (check (is (time/m t) 22)) 7 | (check (is (time/s t) 23)) 8 | (check (is (time/ms t) 0)) 9 | (check (is (time/us t) 0))) 10 | 11 | (check (is (time/m 120) (time/h 2))) 12 | 13 | (check (let [t (time/now)] 14 | (is (- (+ t (time/s 60)) (time/m))) t)) 15 | 16 | (check (let [t (time/now)] 17 | (is (- (+ t (time/D 7)) (time/W))) t)) 18 | 19 | (check (let [t (time/now)] 20 | (is (- (+ t (time/M 12)) (time/Y))) t)) 21 | 22 | (check (is (time/trunc (time/now)) (time/today))) 23 | 24 | (check (let [d (time/m 90) 25 | t (+ (time/today) d)] 26 | (is (time/frac t) d))) 27 | 28 | (check 4 29 | (let [t (Timestamp 2024 1 1)] 30 | #[t..(+ t (time/D 1)):(time/h 6)*])) 31 | 32 | (let [t (Timestamp 2024 9 19)] 33 | (check 'sep (time/MONTHS (time/M t))) 34 | (check 'th (time/WEEKDAYS (time/WD t)))) 35 | 36 | (check (let [t (time/now)] 37 | (is (time/to-local (time/to-utc t) t)))) -------------------------------------------------------------------------------- /tests/type-tests.sl: -------------------------------------------------------------------------------- 1 | (do 2 | (trait Foo) 3 | (trait Bar Foo) 4 | 5 | (check (< Foo Bar)) 6 | (check (not (< Bar Foo))) 7 | 8 | (check (> Bar Foo)) 9 | (check (not (> Foo Bar)))) 10 | 11 | (check 5 12 | (data Foo Int) 13 | (+ (Foo 2) 3)) 14 | 15 | (check 2 16 | (data Bar Map 17 | (^[x y z] {x:1 y:2 z:3})) 18 | 19 | ((Bar 'a 'b 'c) 'b)) --------------------------------------------------------------------------------