diff --git a/.gitignore b/.gitignore index 940794e..c1de26d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,288 +1,6 @@ -## Ignore Visual Studio temporary files, build results, and -## files generated by popular Visual Studio add-ons. -## -## Get latest from https://github.com/github/gitignore/blob/master/VisualStudio.gitignore - -# User-specific files -*.suo -*.user -*.userosscache -*.sln.docstates - -# User-specific files (MonoDevelop/Xamarin Studio) -*.userprefs - -# Build results -[Dd]ebug/ -[Dd]ebugPublic/ -[Rr]elease/ -[Rr]eleases/ -x64/ -x86/ -bld/ -[Bb]in/ -[Oo]bj/ -[Ll]og/ - -# Visual Studio 2015 cache/options directory +bin/ +obj/ .vs/ -# Uncomment if you have tasks that create the project's static files in wwwroot -#wwwroot/ - -# MSTest test Results -[Tt]est[Rr]esult*/ -[Bb]uild[Ll]og.* - -# NUNIT -*.VisualState.xml -TestResult.xml - -# Build Results of an ATL Project -[Dd]ebugPS/ -[Rr]eleasePS/ -dlldata.c - -# .NET Core -project.lock.json -project.fragment.lock.json -artifacts/ -**/Properties/launchSettings.json - -*_i.c -*_p.c -*_i.h -*.ilk -*.meta -*.obj -*.pch -*.pdb -*.pgc -*.pgd -*.rsp -*.sbr -*.tlb -*.tli -*.tlh -*.tmp -*.tmp_proj -*.log -*.vspscc -*.vssscc -.builds -*.pidb -*.svclog -*.scc - -# Chutzpah Test files -_Chutzpah* - -# Visual C++ cache files -ipch/ -*.aps -*.ncb -*.opendb -*.opensdf -*.sdf -*.cachefile -*.VC.db -*.VC.VC.opendb - -# Visual Studio profiler -*.psess -*.vsp -*.vspx -*.sap - -# TFS 2012 Local Workspace -$tf/ - -# Guidance Automation Toolkit -*.gpState - -# ReSharper is a .NET coding add-in -_ReSharper*/ -*.[Rr]e[Ss]harper -*.DotSettings.user - -# JustCode is a .NET coding add-in -.JustCode - -# TeamCity is a build add-in -_TeamCity* - -# DotCover is a Code Coverage Tool -*.dotCover - -# Visual Studio code coverage results -*.coverage -*.coveragexml - -# NCrunch -_NCrunch_* -.*crunch*.local.xml -nCrunchTemp_* - -# MightyMoose -*.mm.* -AutoTest.Net/ - -# Web workbench (sass) -.sass-cache/ - -# Installshield output folder -[Ee]xpress/ - -# DocProject is a documentation generator add-in -DocProject/buildhelp/ -DocProject/Help/*.HxT -DocProject/Help/*.HxC -DocProject/Help/*.hhc -DocProject/Help/*.hhk -DocProject/Help/*.hhp -DocProject/Help/Html2 -DocProject/Help/html - -# Click-Once directory -publish/ - -# Publish Web Output -*.[Pp]ublish.xml -*.azurePubxml -# TODO: Comment the next line if you want to checkin your web deploy settings -# but database connection strings (with potential passwords) will be unencrypted -*.pubxml -*.publishproj - -# Microsoft Azure Web App publish settings. Comment the next line if you want to -# checkin your Azure Web App publish settings, but sensitive information contained -# in these scripts will be unencrypted -PublishScripts/ - -# NuGet Packages -*.nupkg -# The packages folder can be ignored because of Package Restore -**/packages/* -# except build/, which is used as an MSBuild target. -!**/packages/build/ -# Uncomment if necessary however generally it will be regenerated when needed -#!**/packages/repositories.config -# NuGet v3's project.json files produces more ignorable files -*.nuget.props -*.nuget.targets - -# Microsoft Azure Build Output -csx/ -*.build.csdef - -# Microsoft Azure Emulator -ecf/ -rcf/ - -# Windows Store app package directories and files -AppPackages/ -BundleArtifacts/ -Package.StoreAssociation.xml -_pkginfo.txt - -# Visual Studio cache files -# files ending in .cache can be ignored -*.[Cc]ache -# but keep track of directories ending in .cache -!*.[Cc]ache/ - -# Others -ClientBin/ -~$* +*.swp *~ -*.dbmdl -*.dbproj.schemaview -*.jfm -*.pfx -*.publishsettings -orleans.codegen.cs - -# Since there are multiple workflows, uncomment next line to ignore bower_components -# (https://github.com/github/gitignore/pull/1529#issuecomment-104372622) -#bower_components/ - -# RIA/Silverlight projects -Generated_Code/ - -# Backup & report files from converting an old project file -# to a newer Visual Studio version. Backup files are not needed, -# because we have git ;-) -_UpgradeReport_Files/ -Backup*/ -UpgradeLog*.XML -UpgradeLog*.htm - -# SQL Server files -*.mdf -*.ldf -*.ndf - -# Business Intelligence projects -*.rdl.data -*.bim.layout -*.bim_*.settings - -# Microsoft Fakes -FakesAssemblies/ - -# GhostDoc plugin setting file -*.GhostDoc.xml - -# Node.js Tools for Visual Studio -.ntvs_analysis.dat -node_modules/ - -# Typescript v1 declaration files -typings/ - -# Visual Studio 6 build log -*.plg - -# Visual Studio 6 workspace options file -*.opt - -# Visual Studio 6 auto-generated workspace file (contains which files were open etc.) -*.vbw - -# Visual Studio LightSwitch build output -**/*.HTMLClient/GeneratedArtifacts -**/*.DesktopClient/GeneratedArtifacts -**/*.DesktopClient/ModelManifest.xml -**/*.Server/GeneratedArtifacts -**/*.Server/ModelManifest.xml -_Pvt_Extensions - -# Paket dependency manager -.paket/paket.exe -paket-files/ - -# FAKE - F# Make -.fake/ - -# JetBrains Rider -.idea/ -*.sln.iml - -# CodeRush -.cr/ - -# Python Tools for Visual Studio (PTVS) -__pycache__/ -*.pyc - -# Cake - Uncomment if you are using it -# tools/** -# !tools/packages.config - -# Telerik's JustMock configuration file -*.jmconfig - -# BizTalk build output -*.btp.cs -*.btm.cs -*.odx.cs -*.xsd.cs +*.nupkg diff --git a/README.md b/README.md index 72f1506..b5bbfd4 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,197 @@ +# Schemy + +Schemy is a lightweight Scheme-like scripting language interpreter for +embedded use in .NET applications. It's built from scratch without any +external dependency. Its primary goal is to serve as a highly flexible +configuration language. Example scenarios are to describe computational +graph, workflow, or to represent some complex configuration. + +Its design goals are: + +* easy to embed and extend in .NET +* extensible in Scheme via macro expansion +* safe without the need of complicated AppDomain sandboxing. It's safe because + IO functions are not implemented. +* runs reasonably fast and low memory footprint + +Non-goals: + +* be highly optimized - it's designed to load configurations and not part of + any heavy computation, so being optimized is not the goal - e.g., there's no + JIT compiling, etc. + + +Schemy's implementation is inspired by Peter Norvig's [article on Lisp +interpreter][lispy], but is heavily adapted to .NET and engineered to be easily +extensible and embeddable in .NET applications. + + +## Scheme Features + +It has most features that a language would support: + +* number, boolean, string, list types +* varaible, function definition +* tail call optimization +* macro definition +* lexical scoping + + +Many Scheme features are not (yet) supported. Among those are: + +* continuation (`call/cc`) +* use square brackets `[...]` in place of parenthesis `(...)` + + +## Embedding and Extending Schemy + +Schemy is primarily designed to be embedded into a .NET application for +configuration or as a [shell-like interactive environment (REPL)](#repl). To +use Schemy, you can either: + +1. Reference `schemy.dll`, or +2. Copy `src/schemy/*.cs` source code to include in your application. Since + Schemy code base is small. This approach is very feasible (don't forget to + also include the resource file `init.ss`). + + +The below sections describes how to embed and extend Schemy in .NET +applications and in Scheme scripts. For a comprehensive example, please refer +to [`src/examples/command_server`](src/examples/command_server). + + +### Extending Schemy in .NET + +Schemy can be extended by feeding the interpreter symbols with predefined +.NET objects. Variables could be any .NET type. Procedures +must implement `ICallable`. + +An example procedure implementation: + + new NativeProcedure(args => args, "list"); + +This implements the Scheme procedure `list`, which converts its arguments +into a list: + + schemy> (list 1 2 3 4) + (1 2 3 4) + +To "register" extensions, one can pass them to the `Interpreter`'s +constructor: + +```csharp +Interpreter.CreateSymbolTableDelegate extension = itpr => new Dictionary +{ + { Symbol.FromString("list"), new NativeProcedure(args => args, "list") }, +}; + +var interpreter = new Interpreter(new[] { extension }); +``` + + +### Extending Schemy in Scheme + +When launched, the interpreter tries to locate and load Scheme file `.init.ss` +in the same directory as the executing assembly. You can extend Schemy by +putting function, variable, macro definition inside this file. + + +#### Extending with functions + +For example, this function implements the standard Scheme list reversion +function `reverse` (with proper tail call optimization): + +```scheme +(define (reverse ls) + (define loop + (lambda (ls acc) + (if (null? ls) acc + (loop (cdr ls) (cons (car ls) acc))))) + (loop ls '())) +``` + +Use it like so: + +```nohighlight +Schemy> (reverse '(1 2 "foo" "bar")) +("bar" "foo" 2 1) +``` + + +#### Syntax augmentation in Scheme + +For example, we want to augment Schemy with a new syntax for local variable +definition, [`let`][schemepl]. Here's what we want to achieve: + +```nohighlight +Schemy> (let ((x 1) ; let x = 1 + (y 2)) ; let y = 2 + (+ x y)) ; evaluate x + y +3 +``` + +The following macro implements the `let` form by using lambda invocation: + +```scheme +(define-macro let + (lambda args + (define specs (car args)) ; ((var1 val1), ...) + (define bodies (cdr args)) ; (expr1 ...) + (if (null? specs) + `((lambda () ,@bodies)) + (begin + (define spec1 (car specs)) ; (var1 val1) + (define spec_rest (cdr specs)) ; ((var2 val2) ...) + (define inner `((lambda ,(list (car spec1)) ,@bodies) ,(car (cdr spec1)))) + `(let ,spec_rest ,inner))))) +``` + + + +## Use Interactively (REPL) + +The interpreter can be run interactively, when given a `TextReader` for input +and a `TextWriter` for output. + +```csharp +/// Starts the Read-Eval-Print loop +/// the input source +/// the output target +/// a string prompt to be printed before each evaluation +/// a head text to be printed at the beginning of the REPL +public void REPL(TextReader input, TextWriter output, string prompt = null, string[] headers = null) +``` + +This can be useful for expose a remote "shell" for the application, or as +debugging purposes (see how `src/examples/command_server/` uses the `--repl` +command line argument). + +There is an example REPL application in +[`src/examples/repl/`](src/examples/repl/) that can be started as a REPL +interpreter: + + $ schemy.repl.exe + ----------------------------------------------- + | Schemy - Scheme as a Configuration Language | + | Press Ctrl-C to exit | + ----------------------------------------------- + + Schemy> (define (sum-to n acc) + (if (= n 0) + acc + (sum-to (- n 1) (+ acc n)))) + + Schemy> (sum-to 100 0) + 5050 + + Schemy> (sum-to 10000 0) ; proper tail call optimization prevents stack overflow + 50005000 + +Run a script: + + $ schemy.repl.exe + + # Contributing @@ -12,3 +206,10 @@ provided by the bot. You will only need to do this once across all repos using o This project has adopted the [Microsoft Open Source Code of Conduct](https://opensource.microsoft.com/codeofconduct/). For more information see the [Code of Conduct FAQ](https://opensource.microsoft.com/codeofconduct/faq/) or contact [opencode@microsoft.com](mailto:opencode@microsoft.com) with any additional questions or comments. + + + +[schemepl]: http://www.scheme.com/tspl4/start.html#./start:h4 +[lispy]: http://norvig.com/lispy2.html + + diff --git a/doc/example.ss b/doc/example.ss new file mode 100644 index 0000000..1d38aa5 --- /dev/null +++ b/doc/example.ss @@ -0,0 +1,62 @@ +; -------------------- +; Define a variable +; -------------------- +(define str "foo bar") +str + +; -------------------- +; Define a function +; -------------------- +(define (square x) (* x x)) +(square 2) ; call the function + +; -------------------- +; Create a list of numbers +; -------------------- +(define nums (range 0 10)) + +; -------------------- +; Functional programming: +; Map the list into another list using a function +; -------------------- +(map square nums) + + +; -------------------- +; Tail call optimization +; Reverse a list recursively (without stack overflow) +; -------------------- +(define (reverse ls) + (define loop + (lambda (ls acc) + (if (null? ls) acc + (loop (cdr ls) (cons (car ls) acc))))) + (loop ls '())) + +(reverse '(1 2 "foo" "bar")) +(reverse (range 0 10000)) ; NO STACK OVERFLOW! + +; -------------------- +; Using LISP macros to extend the language syntax +; Here we define a `let` syntax that creates local variable for +; only the scope in the `let` block (usage below). +; -------------------- +(define-macro let + (lambda args + (define specs (car args)) ; ((var1 val1), ...) + (define bodies (cdr args)) ; (expr1 ...) + (if (null? specs) + `((lambda () ,@bodies)) + (begin + (define spec1 (car specs)) ; (var1 val1) + (define spec_rest (cdr specs)) ; ((var2 val2) ...) + (define inner `((lambda ,(list (car spec1)) ,@bodies) ,(car (cdr spec1)))) + `(let ,spec_rest ,inner))))) + +; -------------------- +; Usage of the newly created `let` syntax +; -------------------- +(let ((x 1) ; let x = 1 + (y 2)) ; let y = 2 + (+ x y)) ; evaluate x + y + diff --git a/src/examples/command_server/Program.cs b/src/examples/command_server/Program.cs new file mode 100644 index 0000000..ae4291c --- /dev/null +++ b/src/examples/command_server/Program.cs @@ -0,0 +1,135 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +using System; +using System.Collections.Generic; +using System.Diagnostics; +using System.IO; +using System.Linq; +using System.Net; +using System.Net.Sockets; +using System.Reflection; +using System.Text; +using System.Threading.Tasks; +using Schemy; + +namespace Examples.command_server +{ + class Program + { + delegate object Function(object input); + + static void Main(string[] args) + { + Interpreter.CreateSymbolTableDelegate extension = _ => new Dictionary() + { + { Symbol.FromString("get-current-os"), NativeProcedure.Create(() => GetCurrentSystem()) }, + { Symbol.FromString("chain"), new NativeProcedure(funcs => new Function(input => funcs.Cast().Select(b => input = b(input)).Last())) }, + { Symbol.FromString("say-hi"), NativeProcedure.Create(() => name => $"Hello {name}!") }, + { Symbol.FromString("man-freebsd"), NativeProcedure.Create(() => cmd => GetUrl($"https://www.freebsd.org/cgi/man.cgi?query={cmd}&format=ascii")) }, + { Symbol.FromString("man-linux"), NativeProcedure.Create(() => cmd => GetUrl($"http://man7.org/linux/man-pages/man1/{cmd}.1.html")) }, + { Symbol.FromString("truncate-string"), NativeProcedure.Create(len => input => ((string)input).Substring(0, len)) }, + }; + + var interpreter = new Interpreter(new[] { extension }); + + if (args.Contains("--repl")) // start the REPL with all implemented functions + { + interpreter.REPL(Console.In, Console.Out); + return; + } + else + { + // starts a TCP server that receives request (cmd ) and sends response back. + var engines = new Dictionary(); + foreach (var fn in Directory.GetFiles(Path.GetDirectoryName(Assembly.GetEntryAssembly().Location), "*.ss")) + { + Console.WriteLine($"Loading file {fn}"); + LoadScript(interpreter, fn); + engines[Path.GetFileNameWithoutExtension(fn)] = (Function)interpreter.Environment[Symbol.FromString("EXECUTE")]; + } + + string ip = "127.0.0.1"; int port = 8080; + var server = new TcpListener(IPAddress.Parse(ip), port); + server.Start(); + Console.WriteLine($"Server started at {ip}:{port}"); + + try + { + using (var c = server.AcceptTcpClient()) + using (var cs = c.GetStream()) + using (var sr = new StreamReader(cs)) + using (var sw = new StreamWriter(cs)) + { + Console.WriteLine($"Client accepted at {c.Client.RemoteEndPoint}"); + while (!sr.EndOfStream) + { + string line = sr.ReadLine(); + string[] parsed = line.Split(new[] { ' ' }, 2); + if (parsed.Length != 2) + { + sw.WriteLine($"cannot parse {line}"); + sw.Flush(); + } + else + { + string engine = parsed[0], request = parsed[1]; + if (!engines.ContainsKey(engine)) + { + sw.WriteLine($"engine not found: {engine}"); + sw.Flush(); + } + else + { + string output = (string)(engines[engine](request)); + sw.WriteLine(output); + sw.Flush(); + } + } + } + } + } + catch (IOException) { } + } + } + + static void LoadScript(Interpreter interpreter, string file) + { + using (Stream script = File.OpenRead(file)) + using (TextReader reader = new StreamReader(script)) + { + var res = interpreter.Evaluate(reader); + if (res.Error != null) throw res.Error; + } + } + + // support: windows, freebsd, linux, unknown + static string GetCurrentSystem() + { + var os = System.Environment.OSVersion.Platform; + if (os.ToString().Contains("Win")) return "windows"; + if (os == PlatformID.Unix) + { + Process proc = new Process() { StartInfo = new ProcessStartInfo("uname") { RedirectStandardOutput = true } }; + proc.Start(); + var output = proc.StandardOutput.ReadToEnd().Trim(); + proc.WaitForExit(); + + foreach (var w in new[] { "freebsd", "linux" }) + { + if (output.IndexOf(w, StringComparison.OrdinalIgnoreCase) >= 0) return w; + } + } + + return "unknown"; + } + + static string GetUrl(string url) + { + using (var wc = new System.Net.WebClient()) + { + return wc.DownloadString(url); + } + } + } +} diff --git a/src/examples/command_server/README.md b/src/examples/command_server/README.md new file mode 100644 index 0000000..2b0bb82 --- /dev/null +++ b/src/examples/command_server/README.md @@ -0,0 +1,74 @@ +# EXAMPLE: A CONFIGURABLE COMMAND SERVER + +This application is an example use of Schemy to load configurable command +processing pipelines and serve the loaded commands via TCP channel. + +In this application, the server does the following things: + +1. It extends an embedded Schemy interpreter with some functions implemented + in C#. + +2. It finds `.ss` scripts which defines a command processing pipeline by using + those implemented functions. + +3. The server finds and persists the composes pipeline from a script by + looking for the symbol `EXECUTE` which should be of type `Func`. + +4. When a command request comes in, it simply invokes the corresponding + command processor (the one defined by `EXECUTE`), and responses with the + result. + +A simple example is the [`say-hi.ss`](say-hi.ss) script: + +```scheme +; This command processor would echo an input string `name` in the format: +; +; hello name! + +(define EXECUTE (say-hi)) +``` + +As a complex example, [`man.ss`](man.ss) defines a online man-page lookup: + +```scheme +(define EXECUTE + (let ((os (get-current-os)) + (max-length 500)) + (chain ; chain functions together + (cond ; pick a manpage lookup based on OS + ((equal? os "freebsd") (man-freebsd)) + ((equal? os "linux") (man-linux)) + (else (man-freebsd))) + (truncate-string max-length)))) ; truncate output string to a max length +``` + + +With these two scripts loaded the command server, a TCP client can issue commands +`man ` and `sai-hi ` to the server: + +``` +$ ncat 127.0.0.1 8080 + + +say-hi John Doe +Hello John Doe! + + +man ls + +LS(1) FreeBSD General Commands Manual LS(1) + +NAME + ls -- list directory contents + +SYNOPSIS + ls [--libxo] [-ABCFGHILPRSTUWZabcdfghiklmnopqrstuwxy1,] [-D format] + [file ...] + +DESCRIPTION + For each operand that names a file of a type other than directory, ls + displays its name as well as any requested, associated information. For + each operand that names a file of type directory, ls displays the names + of files contained within that directory, as well as any requested, +``` diff --git a/src/examples/command_server/example.command_server.csproj b/src/examples/command_server/example.command_server.csproj new file mode 100644 index 0000000..affba06 --- /dev/null +++ b/src/examples/command_server/example.command_server.csproj @@ -0,0 +1,65 @@ + + + + + Debug + AnyCPU + {88D7E5A3-0BA9-4155-B151-839FF5734F7C} + Exe + Properties + command_server + command_server + v4.5.2 + 512 + true + + + + AnyCPU + true + full + false + bin\Debug\ + DEBUG;TRACE + prompt + 4 + + + AnyCPU + pdbonly + true + bin\Release\ + TRACE + prompt + 4 + + + + + + + + + + + + + + + + + {e54139b7-cb81-4883-b8cd-40bab5420eb8} + schemy + + + + + + + + + + + + + diff --git a/src/examples/command_server/man.ss b/src/examples/command_server/man.ss new file mode 100644 index 0000000..6313088 --- /dev/null +++ b/src/examples/command_server/man.ss @@ -0,0 +1,41 @@ +; This script will be load by the server as command `man`. The command +; is consistent of the following functions chained together: +; +; 1. An online man-page look up - it detects the current operating system and +; decides to use either a linux or freebsd man page web API for the look up. +; +; 2. A string truncator `truncate-string` - it truncates the input string, in +; this case the output of the man-page lookup, to the specified number of +; characters. +; +; The client of the command server connects via raw RCP protocol, and can issue +; commands like: +; +; man ls +; +; and gets response like: +; +; LS(1) FreeBSD General Commands Manual LS(1) +; +; NAME +; ls -- list directory contents +; +; SYNOPSIS +; ls [--libxo] [-ABCFGHILPRSTUWZabcdfghiklmnopqrstuwxy1,] [-D format] +; [file ...] +; +; DESCRIPTION +; For each operand that names a file of a type other than directory, ls +; displays its name as well as any requested, associated information. For +; each operand that names a file of type directory, ls displays the names +; of files contained within that directory, as well as any requested, + +(define EXECUTE + (let ((os (get-current-os)) + (max-length 500)) + (chain ; chain functions together + (cond ; pick a manpage lookup based on OS + ((equal? os "freebsd") (man-freebsd)) + ((equal? os "linux") (man-linux)) + (else (man-freebsd))) + (truncate-string max-length)))) ; truncate output string to a max length diff --git a/src/examples/command_server/say-hi.ss b/src/examples/command_server/say-hi.ss new file mode 100644 index 0000000..7ace2cf --- /dev/null +++ b/src/examples/command_server/say-hi.ss @@ -0,0 +1,5 @@ +; This command processor would echo an input string `name` in the format: +; +; hello name! + +(define EXECUTE (say-hi)) diff --git a/src/examples/repl/.init.ss b/src/examples/repl/.init.ss new file mode 100644 index 0000000..b178eb8 --- /dev/null +++ b/src/examples/repl/.init.ss @@ -0,0 +1,2 @@ +; `.init.ss` is picked up by interpreter automatically +(define square (lambda (x) (* x x))) diff --git a/src/examples/repl/Program.cs b/src/examples/repl/Program.cs new file mode 100644 index 0000000..174cc8a --- /dev/null +++ b/src/examples/repl/Program.cs @@ -0,0 +1,41 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace Schemy +{ + using System; + using System.IO; + + public static class Program + { + public static void Main(string[] args) + { + if (args.Length > 0 && File.Exists(args[0])) + { + // evaluate input file's content + var file = args[0]; + var interpreter = new Interpreter(); + + using (TextReader reader = new StreamReader(file)) + { + object res = interpreter.Evaluate(reader); + Console.WriteLine(Utils.PrintExpr(res)); + } + } + else + { + // starts the REPL + var interpreter = new Interpreter(); + var headers = new[] + { + "-----------------------------------------------", + "| Schemy - Scheme as a Configuration Language |", + "| Press Ctrl-C to exit |", + "-----------------------------------------------", + }; + + interpreter.REPL(Console.In, Console.Out, "Schemy> ", headers); + } + } + } +} diff --git a/src/examples/repl/example.repl.csproj b/src/examples/repl/example.repl.csproj new file mode 100644 index 0000000..7296fa8 --- /dev/null +++ b/src/examples/repl/example.repl.csproj @@ -0,0 +1,67 @@ + + + + + Debug + AnyCPU + {56DADEFC-6B30-4C0F-AAEA-23D684BD817F} + Exe + Properties + Schemy + schemy.repl + v4.5.2 + 512 + true + + + + AnyCPU + true + full + false + bin\Debug\ + DEBUG;TRACE + prompt + 4 + + + AnyCPU + pdbonly + true + bin\Release\ + TRACE + prompt + 4 + + + + + + + + + + + + + + + + + {e54139b7-cb81-4883-b8cd-40bab5420eb8} + schemy + + + + + + + + + + + diff --git a/src/repl/.init.ss b/src/repl/.init.ss new file mode 100644 index 0000000..b178eb8 --- /dev/null +++ b/src/repl/.init.ss @@ -0,0 +1,2 @@ +; `.init.ss` is picked up by interpreter automatically +(define square (lambda (x) (* x x))) diff --git a/src/repl/Program.cs b/src/repl/Program.cs new file mode 100644 index 0000000..174cc8a --- /dev/null +++ b/src/repl/Program.cs @@ -0,0 +1,41 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace Schemy +{ + using System; + using System.IO; + + public static class Program + { + public static void Main(string[] args) + { + if (args.Length > 0 && File.Exists(args[0])) + { + // evaluate input file's content + var file = args[0]; + var interpreter = new Interpreter(); + + using (TextReader reader = new StreamReader(file)) + { + object res = interpreter.Evaluate(reader); + Console.WriteLine(Utils.PrintExpr(res)); + } + } + else + { + // starts the REPL + var interpreter = new Interpreter(); + var headers = new[] + { + "-----------------------------------------------", + "| Schemy - Scheme as a Configuration Language |", + "| Press Ctrl-C to exit |", + "-----------------------------------------------", + }; + + interpreter.REPL(Console.In, Console.Out, "Schemy> ", headers); + } + } + } +} diff --git a/src/repl/repl.csproj b/src/repl/repl.csproj new file mode 100644 index 0000000..6e7a067 --- /dev/null +++ b/src/repl/repl.csproj @@ -0,0 +1,67 @@ + + + + + Debug + AnyCPU + {56DADEFC-6B30-4C0F-AAEA-23D684BD817F} + Exe + Properties + Schemy + schemy.repl + v4.5.2 + 512 + true + + + + AnyCPU + true + full + false + bin\Debug\ + DEBUG;TRACE + prompt + 4 + + + AnyCPU + pdbonly + true + bin\Release\ + TRACE + prompt + 4 + + + + + + + + + + + + + + + + + {e54139b7-cb81-4883-b8cd-40bab5420eb8} + schemy + + + + + + + + + + + \ No newline at end of file diff --git a/src/schemy.sln b/src/schemy.sln new file mode 100644 index 0000000..35c1451 --- /dev/null +++ b/src/schemy.sln @@ -0,0 +1,40 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 14 +VisualStudioVersion = 14.0.25420.1 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "schemy", "schemy\schemy.csproj", "{E54139B7-CB81-4883-B8CD-40BAB5420EB8}" +EndProject +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "test", "test\test.csproj", "{4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}" +EndProject +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "example.repl", "examples\repl\example.repl.csproj", "{56DADEFC-6B30-4C0F-AAEA-23D684BD817F}" +EndProject +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "example.command_server", "examples\command_server\example.command_server.csproj", "{88D7E5A3-0BA9-4155-B151-839FF5734F7C}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Release|Any CPU = Release|Any CPU + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {E54139B7-CB81-4883-B8CD-40BAB5420EB8}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {E54139B7-CB81-4883-B8CD-40BAB5420EB8}.Debug|Any CPU.Build.0 = Debug|Any CPU + {E54139B7-CB81-4883-B8CD-40BAB5420EB8}.Release|Any CPU.ActiveCfg = Release|Any CPU + {E54139B7-CB81-4883-B8CD-40BAB5420EB8}.Release|Any CPU.Build.0 = Release|Any CPU + {4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}.Debug|Any CPU.Build.0 = Debug|Any CPU + {4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}.Release|Any CPU.ActiveCfg = Release|Any CPU + {4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}.Release|Any CPU.Build.0 = Release|Any CPU + {56DADEFC-6B30-4C0F-AAEA-23D684BD817F}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {56DADEFC-6B30-4C0F-AAEA-23D684BD817F}.Debug|Any CPU.Build.0 = Debug|Any CPU + {56DADEFC-6B30-4C0F-AAEA-23D684BD817F}.Release|Any CPU.ActiveCfg = Release|Any CPU + {56DADEFC-6B30-4C0F-AAEA-23D684BD817F}.Release|Any CPU.Build.0 = Release|Any CPU + {88D7E5A3-0BA9-4155-B151-839FF5734F7C}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {88D7E5A3-0BA9-4155-B151-839FF5734F7C}.Debug|Any CPU.Build.0 = Debug|Any CPU + {88D7E5A3-0BA9-4155-B151-839FF5734F7C}.Release|Any CPU.ActiveCfg = Release|Any CPU + {88D7E5A3-0BA9-4155-B151-839FF5734F7C}.Release|Any CPU.Build.0 = Release|Any CPU + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection +EndGlobal diff --git a/src/schemy/Builtins.cs b/src/schemy/Builtins.cs new file mode 100644 index 0000000..2f0fd5b --- /dev/null +++ b/src/schemy/Builtins.cs @@ -0,0 +1,165 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace Schemy +{ + using System; + using System.Collections.Generic; + using System.IO; + using System.Linq; + + /// + /// Extend the interpreter with essential builtin functionalities + /// + public class Builtins + { + public static IDictionary CreateBuiltins(Interpreter interpreter) + { + var builtins = new Dictionary(); + + builtins[Symbol.FromString("+")] = new NativeProcedure(Utils.MakeVariadic(Add), "+"); + builtins[Symbol.FromString("-")] = new NativeProcedure(Utils.MakeVariadic(Minus), "-"); + builtins[Symbol.FromString("*")] = new NativeProcedure(Utils.MakeVariadic(Multiply), "*"); + builtins[Symbol.FromString("/")] = new NativeProcedure(Utils.MakeVariadic(Divide), "/"); + builtins[Symbol.FromString("=")] = NativeProcedure.Create((x, y) => x == y, "="); + builtins[Symbol.FromString("<")] = NativeProcedure.Create((x, y) => x < y, "<"); + builtins[Symbol.FromString("<=")] = NativeProcedure.Create((x, y) => x <= y, "<="); + builtins[Symbol.FromString(">")] = NativeProcedure.Create((x, y) => x > y, ">"); + builtins[Symbol.FromString(">=")] = NativeProcedure.Create((x, y) => x >= y, ">="); + builtins[Symbol.FromString("eq?")] = NativeProcedure.Create((x, y) => object.ReferenceEquals(x, y), "eq?"); + builtins[Symbol.FromString("equal?")] = NativeProcedure.Create(EqualImpl, "equal?"); + builtins[Symbol.FromString("boolean?")] = NativeProcedure.Create(x => x is bool, "boolean?"); + builtins[Symbol.FromString("num?")] = NativeProcedure.Create(x => x is int || x is double, "num?"); + builtins[Symbol.FromString("string?")] = NativeProcedure.Create(x => x is string, "string?"); + builtins[Symbol.FromString("symbol?")] = NativeProcedure.Create(x => x is Symbol, "symbol?"); + builtins[Symbol.FromString("list?")] = NativeProcedure.Create(x => x is List, "list?"); + builtins[Symbol.FromString("map")] = NativeProcedure.Create, List>((func, ls) => ls.Select(x => func.Call(new List { x })).ToList()); + builtins[Symbol.FromString("reverse")] = NativeProcedure.Create, List>(ls => ls.Reverse().ToList()); + builtins[Symbol.FromString("range")] = new NativeProcedure(RangeImpl, "range"); + builtins[Symbol.FromString("apply")] = NativeProcedure.Create, object>((proc, args) => proc.Call(args), "apply"); + builtins[Symbol.FromString("list")] = new NativeProcedure(args => args, "list"); + builtins[Symbol.FromString("list-ref")] = NativeProcedure.Create, int, object>((ls, idx) => ls[idx]); + builtins[Symbol.FromString("length")] = NativeProcedure.Create, int>(list => list.Count, "length"); + builtins[Symbol.FromString("car")] = NativeProcedure.Create, object>(args => args[0], "car"); + builtins[Symbol.FromString("cdr")] = NativeProcedure.Create, List>(args => args.Skip(1).ToList(), "cdr"); + builtins[Symbol.CONS] = NativeProcedure.Create, List>((x, ys) => Enumerable.Concat(new[] { x }, ys).ToList(), "cons"); + builtins[Symbol.FromString("not")] = NativeProcedure.Create(x => !x, "not"); + builtins[Symbol.APPEND] = NativeProcedure.Create, List, List>((l1, l2) => Enumerable.Concat(l1, l2).ToList(), "append"); + builtins[Symbol.FromString("null?")] = NativeProcedure.Create(x => x is List && ((List)x).Count == 0, "null?"); + builtins[Symbol.FromString("assert")] = new NativeProcedure(AssertImpl, "assert"); + builtins[Symbol.FromString("load")] = NativeProcedure.Create(filename => LoadImpl(interpreter, filename), "load"); + builtins[Symbol.FromString("null")] = NativeProcedure.Create(() => (object)null, "null"); + builtins[Symbol.FromString("null?")] = NativeProcedure.Create(x => x is List && ((List)x).Count == 0, "null?"); + builtins[Symbol.FromString("assert")] = new NativeProcedure(AssertImpl, "assert"); + builtins[Symbol.FromString("load")] = NativeProcedure.Create(filename => LoadImpl(interpreter, filename), "load"); + + return builtins; + } + + #region Builtin Implementations + + private static List RangeImpl(List args) + { + Utils.CheckSyntax(args, args.Count >= 1 && args.Count <= 3); + foreach (var item in args) + { + Utils.CheckSyntax(args, item is int, "items must be integers"); + } + + int start, end, step; + if (args.Count == 1) + { + start = 0; + end = (int)args[0]; + step = 1; + } + else if (args.Count == 2) + { + start = (int)args[0]; + end = (int)args[1]; + step = 1; + } + else + { + start = (int)args[0]; + end = (int)args[1]; + step = (int)args[2]; + } + + if (start < end) Utils.CheckSyntax(args, step > 0, "step must make the sequence end"); + if (start > end) Utils.CheckSyntax(args, step < 0, "step must make the sequence end"); + + var res = new List(); + + if (start <= end) for (int i = start; i < end; i += step) res.Add(i); + else for (int i = start; i > end; i += step) res.Add(i); + + res.TrimExcess(); + return res; + } + + private static None AssertImpl(List args) + { + Utils.CheckArity(args, 1, 2); + string msg = "Assertion failed"; + msg += args.Count > 1 ? ": " + Utils.ConvertType(args[1]) : string.Empty; + bool pred = Utils.ConvertType(args[0]); + if (!pred) throw new AssertionFailedError(msg); + return None.Instance; + } + + private static None LoadImpl(Interpreter interpreter, string filename) + { + using (TextReader reader = new StreamReader(interpreter.FileSystemAccessor.OpenRead(filename))) + { + interpreter.Evaluate(reader); + } + + return None.Instance; + } + + public static bool EqualImpl(object x, object y) + { + if (object.Equals(x, y)) return true; + if (x == null || y == null) return false; + + if (x is IList && y is IList) + { + var x2 = (IList)x; + var y2 = (IList)y; + if (x2.Count != y2.Count) return false; + return Enumerable.Zip(x2, y2, (a, b) => Tuple.Create(a, b)) + .All(pair => EqualImpl(pair.Item1, pair.Item2)); + } + + return false; + } + + private static object Add(object x, object y) + { + if (x is int && y is int) return (int)x + (int)y; + return (double)System.Convert.ChangeType(x, typeof(double)) + (double)System.Convert.ChangeType(y, typeof(double)); + } + + private static object Minus(object x, object y) + { + if (x is int && y is int) return (int)x - (int)y; + return (double)System.Convert.ChangeType(x, typeof(double)) - (double)System.Convert.ChangeType(y, typeof(double)); + } + + private static object Multiply(object x, object y) + { + if (x is int && y is int) return (int)x * (int)y; + return (double)System.Convert.ChangeType(x, typeof(double)) * (double)System.Convert.ChangeType(y, typeof(double)); + } + + private static object Divide(object x, object y) + { + if (x is int && y is int) return (int)x / (int)y; + return (double)System.Convert.ChangeType(x, typeof(double)) / (double)System.Convert.ChangeType(y, typeof(double)); + } + + #endregion Builtin Implementations + } +} + diff --git a/src/schemy/CommonTypes.cs b/src/schemy/CommonTypes.cs new file mode 100644 index 0000000..930e3a3 --- /dev/null +++ b/src/schemy/CommonTypes.cs @@ -0,0 +1,56 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace Schemy +{ + using System; + using System.Collections.Generic; + + public class None + { + public static readonly None Instance = new None(); + } + + class AssertionFailedError : Exception + { + public AssertionFailedError(string msg) : base(msg) + { + } + } + + class SyntaxError : Exception + { + public SyntaxError(string msg) : base(msg) + { + } + } + + /// + /// Poor man's discreminated union + /// + public class Union + { + private readonly object data; + public Union(T1 data) + { + this.data = data; + } + + public Union(T2 data) + { + this.data = data; + } + + public TResult Use(Func func1, Func func2) + { + if (this.data is T1) + { + return func1((T1)this.data); + } + else + { + return func2((T2)this.data); + } + } + } +} diff --git a/src/schemy/Env.cs b/src/schemy/Env.cs new file mode 100644 index 0000000..5ac814a --- /dev/null +++ b/src/schemy/Env.cs @@ -0,0 +1,107 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace Schemy +{ + using System.Collections.Generic; + + /// + /// Tracks the state of an interpreter or a procedure. It supports lexical scoping. + /// + public class Environment + { + private readonly IDictionary store; + + /// + /// The enclosing environment. For top level env, this is null. + /// + private readonly Environment outer; + + public Environment(IDictionary env, Environment outer) + { + this.store = env; + this.outer = outer; + } + + public static Environment CreateEmpty() + { + return new Environment(new Dictionary(), null); + } + + public static Environment FromVariablesAndValues(Union> parameters, List values, Environment outer) + { + return parameters.Use( + @params => new Environment(new Dictionary() { { @params, values } }, outer), + @params => + { + if (values.Count != @params.Count) + { + throw new SyntaxError(string.Format("Unexpected number of arguments. Expecting {0}, Got {1}.", @params.Count, values.Count)); + } + + var dict = new Dictionary(); + for (int i = 0; i < values.Count; i++) + { + dict[@params[i]] = values[i]; + } + + return new Environment(dict, outer); + }); + } + + /// + /// Attempts to get the value of the symbol. If it's not found in current env, recursively try the enclosing env. + /// + /// The value of the symbol to find + /// if the symbol's value could be found + public bool TryGetValue(Symbol sym, out object val) + { + Environment env = this.TryFindContainingEnv(sym); + if (env != null) + { + val = env.store[sym]; + return true; + } + else + { + val = null; + return false; + } + } + + /// + /// Attempts to find the env that actually defines the symbol + /// + /// The symbol to find + /// the env that defines the symbol + public Environment TryFindContainingEnv(Symbol sym) + { + object val; + if (this.store.TryGetValue(sym, out val)) return this; + if (this.outer != null) return this.outer.TryFindContainingEnv(sym); + return null; + } + + public object this[Symbol sym] + { + get + { + object val; + if (this.TryGetValue(sym, out val)) + { + return val; + } + else + { + throw new KeyNotFoundException(string.Format("Symbol not defined: {0}", sym)); + } + } + + set + { + this.store[sym] = value; + } + } + } +} + diff --git a/src/schemy/FileSystemAccessor.cs b/src/schemy/FileSystemAccessor.cs new file mode 100644 index 0000000..263c7d4 --- /dev/null +++ b/src/schemy/FileSystemAccessor.cs @@ -0,0 +1,52 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace Schemy +{ + using System; + using System.IO; + + /// + /// The only interface that the file system should be exposed within a Schemy interpreter. + /// + /// + /// One could implement this interface in a way such that the interpreter can be used to access "files" in + /// any logical virtual file system. For security purposes, one could also choose to not implement, say, + /// if the interpreter is used in a way that write does not need to supported. + /// The other (higher) level of protection would be to not expose any builtin function for writing to the file system. + /// + public interface IFileSystemAccessor + { + /// + /// Opens the path for read + /// + /// The path + /// the stream to read + Stream OpenRead(string path); + + /// + /// Opens the path for write + /// + /// The path + /// the stream to write + Stream OpenWrite(string path); + } + + /// + /// An implementation of that grants readonly access to the host file system. + /// + /// + public class ReadOnlyFileSystemAccessor : IFileSystemAccessor + { + public Stream OpenRead(string path) + { + return File.OpenRead(path); + } + + public Stream OpenWrite(string path) + { + throw new NotSupportedException("Writing to file system is not supported"); + } + } +} + diff --git a/src/schemy/Procedure.cs b/src/schemy/Procedure.cs new file mode 100644 index 0000000..f5618db --- /dev/null +++ b/src/schemy/Procedure.cs @@ -0,0 +1,217 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +using System; +using System.Collections.Generic; +using System.Linq; + +namespace Schemy +{ + /// + /// Represents a procedure value in Scheme + /// + interface ICallable + { + /// + /// Invokes this procedure + /// + /// The arguments. These are the `cdr` of the s-expression for the procedure invocation. + /// the result of the procedure invocation + object Call(List args); + } + + /// + /// A procedure implemented in Scheme + /// + /// + public class Procedure : ICallable + { + private readonly Union> parameters; + private readonly object body; + private readonly Environment env; + + public Procedure(Union> parameters, object body, Environment env) + { + this.parameters = parameters; + this.body = body; + this.env = env; + } + + public object Body + { + get { return this.body; } + } + + public Union> Parameters + { + get { return this.parameters; } + } + + public Environment Env + { + get { return this.env; } + } + + /// + /// Invokes this procedure + /// + /// + /// Implementation note: under normal function invocation scenarios, this method is not used. Instead, + /// a tail call optimization is used in the interpreter evaluation phase that runs Scheme functions. + /// + /// This method is useful however, in macro expansions, and any other occasions where the tail call optimization + /// is not (yet) implemented. + /// + /// + /// + public object Call(List args) + { + // NOTE: This is not needed for regular function invoke after the tail call optimization. + // a (non-native) procedure is now optimized into evaluating the body under the environment + // formed by the (params, args). So the `Call` method will never be used. + return Interpreter.EvaluateExpression(this.body, Environment.FromVariablesAndValues(this.parameters, args, this.env)); + } + + /// + /// Prints the implementation of the function. + /// + public override string ToString() + { + var form = new List { Symbol.LAMBDA, this.parameters.Use(sym => (object)sym, syms => syms.Cast().ToList()), this.body }; + return Utils.PrintExpr(form); + } + } + + /// + /// A procedure implemented in .NET + /// + /// + public class NativeProcedure : ICallable + { + private readonly Func, object> func; + private readonly string name; + + public NativeProcedure(Func, object> func, string name = null) + { + this.func = func; + this.name = name; + } + + public object Call(List args) + { + return this.func(args); + } + + /// + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 7); + return func( + Utils.ConvertType(args[0]), + Utils.ConvertType(args[1]), + Utils.ConvertType(args[2]), + Utils.ConvertType(args[3]), + Utils.ConvertType(args[4]), + Utils.ConvertType(args[5]), + Utils.ConvertType(args[6]) + ); + }, name); + } + + /// + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 4); + return func( + Utils.ConvertType(args[0]), + Utils.ConvertType(args[1]), + Utils.ConvertType(args[2]), + Utils.ConvertType(args[3])); + }, name); + } + + /// + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 3); + return func( + Utils.ConvertType(args[0]), + Utils.ConvertType(args[1]), + Utils.ConvertType(args[2])); + }, name); + } + + /// + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 2); + return func(Utils.ConvertType(args[0]), Utils.ConvertType(args[1])); + }, name); + } + + /// + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// The type of the 1st argument + /// The type of the 2nd argument + /// The function implementation + /// The name of the function + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 1); + return func(Utils.ConvertType(args[0])); + }, name); + } + + /// + /// Convenient function method to create a native procedure and doing arity and type check for inputs. It makes the input function + /// implementation strongly typed. + /// + /// + public static NativeProcedure Create(Func func, string name = null) + { + return new NativeProcedure(args => + { + Utils.CheckArity(args, 0); + return func(); + }, name); + } + + /// + /// ToString implementation + /// + /// the string representation + public override string ToString() + { + return string.Format("#", string.IsNullOrEmpty(this.name) ? "noname" : this.name); + } + } +} + diff --git a/src/schemy/Program.cs b/src/schemy/Program.cs new file mode 100644 index 0000000..d8d87b8 --- /dev/null +++ b/src/schemy/Program.cs @@ -0,0 +1,69 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +using System; +using System.IO; + +namespace Schemy +{ + public static class Program + { + /// + /// Initializes the interpreter with a init script if present. + /// + static void Initialize(Interpreter interpreter) + { + string initFile = Path.Combine(Path.GetDirectoryName(typeof(Interpreter).Assembly.Location), ".init.ss"); + if (File.Exists(initFile)) + { + using (var reader = new StreamReader(initFile)) + { + var res = interpreter.Evaluate(reader); + if (res.Error != null) + { + Console.WriteLine(string.Format("Error loading {0}: {1}{2}", + initFile, + System.Environment.NewLine, + res.Error)); + } + else + { + Console.WriteLine("Loaded init file: " + initFile); + } + } + } + } + + static void Main(string[] args) + { + if (args.Length > 0 && File.Exists(args[0])) + { + // evaluate input file's content + var file = args[0]; + var interpreter = new Interpreter(); + Initialize(interpreter); + + using (TextReader reader = new StreamReader(file)) + { + object res = interpreter.Evaluate(reader); + Console.WriteLine(Utils.PrintExpr(res)); + } + } + else + { + // starts the REPL + var interpreter = new Interpreter(); + Initialize(interpreter); + var headers = new[] + { + "-----------------------------------------------", + "| Schemy - Scheme as a Configuration Language |", + "| Press Ctrl-C to exit |", + "-----------------------------------------------", + }; + + interpreter.REPL(Console.In, Console.Out, "Schemy> ", headers); + } + } + } +} diff --git a/src/schemy/Properties/AssemblyInfo.cs b/src/schemy/Properties/AssemblyInfo.cs new file mode 100644 index 0000000..fda52c9 --- /dev/null +++ b/src/schemy/Properties/AssemblyInfo.cs @@ -0,0 +1,38 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +using System.Reflection; +using System.Runtime.CompilerServices; +using System.Runtime.InteropServices; + +// General Information about an assembly is controlled through the following +// set of attributes. Change these attribute values to modify the information +// associated with an assembly. +[assembly: AssemblyTitle("schemy")] +[assembly: AssemblyDescription("A lightweight, embeddable Scheme-like language interpreter")] +[assembly: AssemblyConfiguration("")] +[assembly: AssemblyCompany("Microsoft")] +[assembly: AssemblyProduct("schemy")] +[assembly: AssemblyCopyright("Copyright © 2017")] +[assembly: AssemblyCulture("")] + +// Setting ComVisible to false makes the types in this assembly not visible +// to COM components. If you need to access a type in this assembly from +// COM, set the ComVisible attribute to true on that type. +[assembly: ComVisible(false)] + +// The following GUID is for the ID of the typelib if this project is exposed to COM +[assembly: Guid("e54139b7-cb81-4883-b8cd-40bab5420eb8")] + +// Version information for an assembly consists of the following four values: +// +// Major Version +// Minor Version +// Build Number +// Revision +// +// You can specify all the values or you can default the Build and Revision Numbers +// by using the '*' as shown below: +// [assembly: AssemblyVersion("1.0.*")] +[assembly: AssemblyVersion("1.0.0.0")] +[assembly: AssemblyFileVersion("1.0.0.0")] diff --git a/src/schemy/Schemy.cs b/src/schemy/Schemy.cs new file mode 100644 index 0000000..322736a --- /dev/null +++ b/src/schemy/Schemy.cs @@ -0,0 +1,583 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace Schemy +{ + using System; + using System.Collections.Generic; + using System.IO; + using System.Linq; + using System.Text.RegularExpressions; + using System.Reflection; + + public class Interpreter + { + private readonly Environment environment; + private readonly Dictionary macroTable; + private readonly IFileSystemAccessor fsAccessor; + + public delegate IDictionary CreateSymbolTableDelegate(Interpreter interpreter); + + /// + /// Initializes a new instance of the class. + /// + /// Array of environment initializers + /// The file system accessor + public Interpreter(IEnumerable environmentInitializers = null, IFileSystemAccessor fsAccessor = null) + { + this.fsAccessor = fsAccessor; + if (this.fsAccessor == null) + { + this.fsAccessor = new ReadOnlyFileSystemAccessor(); + } + + // populate an empty environment for the initializer to potentially work with + this.environment = Environment.CreateEmpty(); + this.macroTable = new Dictionary(); + + environmentInitializers = environmentInitializers ?? new List(); + environmentInitializers = new CreateSymbolTableDelegate[] { Builtins.CreateBuiltins }.Concat(environmentInitializers); + + foreach (CreateSymbolTableDelegate initializer in environmentInitializers) + { + this.environment = new Environment(initializer(this), this.environment); + } + + foreach (var iniReader in GetInitializeFiles()) + { + this.Evaluate(iniReader); + } + } + + private IEnumerable GetInitializeFiles() + { + using (Stream stream = Assembly.GetExecutingAssembly().GetManifestResourceStream("init.ss")) + using (StreamReader reader = new StreamReader(stream)) + { + yield return reader; + } + + string initFile = Path.Combine(Path.GetDirectoryName(Assembly.GetEntryAssembly().Location), ".init.ss"); + if (File.Exists(initFile)) + { + using (var reader = new StreamReader(initFile)) + { + yield return reader; + } + } + } + + public IFileSystemAccessor FileSystemAccessor { get { return this.fsAccessor; } } + + public Environment Environment { get { return this.environment; } } + + /// + /// Evaluate script from a input reader + /// + /// the input source + /// the value of the last expression + public EvaluationResult Evaluate(TextReader input) + { + InPort port = new InPort(input); + object res = null; + while (true) + { + try + { + var expr = Expand(Read(port), environment, macroTable, true); + if (Symbol.EOF.Equals(expr)) + { + return new EvaluationResult(null, res); + } + else + { + res = EvaluateExpression(expr, environment); + } + } + catch (Exception e) + { + return new EvaluationResult(e, null); + } + } + } + + /// + /// Starts the Read-Eval-Print loop + /// + /// the input source + /// the output target + /// a string prompt to be printed before each evaluation + /// a head text to be printed at the beginning of the REPL + public void REPL(TextReader input, TextWriter output, string prompt = null, string[] headers = null) + { + InPort port = new InPort(input); + + if (headers != null) + { + foreach (var line in headers) + { + output.WriteLine(line); + } + } + + object res = null; + while (true) + { + try + { + if (!string.IsNullOrEmpty(prompt) && output != null) output.Write(prompt); + var expr = Expand(Read(port), environment, macroTable, true); + if (Symbol.EOF.Equals(expr)) + { + return; + } + else + { + res = EvaluateExpression(expr, environment); + if (output != null) output.WriteLine(Utils.PrintExpr(res)); + } + } + catch (Exception e) + { + Console.WriteLine(e.Message); + } + } + } + + /// + /// Defines a global symbol + /// + /// the symbol + /// the associated value + public void DefineGlobal(Symbol sym, object val) + { + this.environment[sym] = val; + } + + /// + /// Reads an S-expression from the input source + /// + public static object Read(InPort port) + { + Func readAhead = null; + readAhead = token => + { + Symbol quote; + if (object.Equals(token, Symbol.EOF)) + { + throw new SyntaxError("unexpected EOF"); + } + else if (token is string) + { + string tokenStr = (string)token; + if (tokenStr == "(") + { + var L = new List(); + while (true) + { + token = port.NextToken(); + if (token is string && (string)token == ")") + { + return L; + } + else + { + L.Add(readAhead(token)); + } + } + } + else if (tokenStr == ")") + { + throw new SyntaxError("unexpected )"); + } + else if (Symbol.QuotesMap.TryGetValue(tokenStr, out quote)) + { + object quoted = Read(port); + return new List { quote, quoted }; + } + else + { + return ParseAtom(tokenStr); + } + } + else + { + throw new SyntaxError("unexpected token: " + token); + } + }; + + var token1 = port.NextToken(); + return Symbol.EOF.Equals(token1) ? Symbol.EOF : readAhead(token1); + } + + /// + /// Validates and expands the input s-expression + /// + /// expression to expand + /// env used to evaluate the macro procedures + /// the macro definition table + /// whether the current expansion is at the top level + /// the s-expression after validation and expansion + public static object Expand(object expression, Environment env, Dictionary macroTable, bool isTopLevel = true) + { + Procedure procedure = null; + Func expand = null; + expand = (x, topLevel) => + { + if (!(x is List)) + { + return x; + } + + List xs = (List)x; + Utils.CheckSyntax(xs, xs.Count > 0); + + if (Symbol.QUOTE.Equals(xs[0])) + { + Utils.CheckSyntax(xs, xs.Count == 2); + return xs; + } + else if (Symbol.IF.Equals(xs[0])) + { + if (xs.Count == 3) + { + xs.Add(None.Instance); + } + + Utils.CheckSyntax(xs, xs.Count == 4); + return xs.Select(expr => expand(expr, false)).ToList(); + } + else if (Symbol.SET.Equals(xs[0])) + { + Utils.CheckSyntax(xs, xs.Count == 3); + Utils.CheckSyntax(xs, xs[1] is Symbol, "can only set! a symbol"); + return new List { Symbol.SET, xs[1], expand(xs[2], false) }; + } + else if (Symbol.DEFINE.Equals(xs[0]) || Symbol.DEFINE_MACRO.Equals(xs[0])) + { + Utils.CheckSyntax(xs, xs.Count >= 3); + Symbol def = (Symbol)xs[0]; + object v = xs[1]; // sym or (sym+) + List body = xs.Skip(2).ToList(); // expr or expr+ + if (v is List) + { + // (define (f args) body) + var args = (List)v; + Utils.CheckSyntax(xs, args.Count > 0); + var f = args[0]; + var @params = args.Skip(1).ToList(); + return expand(new List { def, f, Enumerable.Concat(new object[] { Symbol.LAMBDA, @params }, body).ToList() }, false); + } + else + { + Utils.CheckSyntax(xs, xs.Count == 3); // (define x expr) + Utils.CheckSyntax(xs, v is Symbol); + var expr = expand(xs[2], false); + if (Symbol.DEFINE_MACRO.Equals(def)) + { + Utils.CheckSyntax(xs, topLevel, "define-macro is only allowed at the top level"); + var proc = EvaluateExpression(expr, env); + Utils.CheckSyntax(xs, proc is Procedure, "macro must be a procedure"); + macroTable[(Symbol)v] = (Procedure)proc; + return None.Instance; + } + else + { + // `define v expr` + return new List { Symbol.DEFINE, v, expr /* after expansion */ }; + } + } + } + else if (Symbol.BEGIN.Equals(xs[0])) + { + if (xs.Count == 1) return None.Instance; // (begin) => None + + // use the same topLevel so that `define-macro` is also allowed in a top-level `begin`. + return xs.Select(expr => expand(expr, topLevel)).ToList(); + } + else if (Symbol.LAMBDA.Equals(xs[0])) + { + Utils.CheckSyntax(xs, xs.Count >= 3); + var vars = xs[1]; + Utils.CheckSyntax(xs, vars is Symbol || (vars is List && ((List)vars).All(v => v is Symbol)), "illigal lambda argument"); + + object body; + if (xs.Count == 3) + { + // (lambda (...) expr) + body = xs[2]; + } + else + { + // (lambda (...) expr+ + body = Enumerable.Concat(new[] { Symbol.BEGIN }, xs.Skip(2)).ToList(); + } + + return new List { Symbol.LAMBDA, vars, expand(body, false) }; + } + else if (Symbol.QUASIQUOTE.Equals(xs[0])) + { + Utils.CheckSyntax(xs, xs.Count == 2); + return ExpandQuasiquote(xs[1]); + } + else if (xs[0] is Symbol && macroTable.TryGetValue((Symbol)xs[0], out procedure)) + { + return expand(procedure.Call(xs.Skip(1).ToList()), topLevel); + } + else + { + return xs.Select(p => expand(p, false)).ToList(); + } + }; + return expand(expression, isTopLevel); + } + + /// + /// Evaluates an s-expression + /// + /// expression to be evaluated + /// the environment in which the expression is evaluated + /// the result of the evaluation + public static object EvaluateExpression(object expr, Environment env) + { + while (true) + { + if (expr is Symbol) + { + return env[(Symbol)expr]; + } + else if (!(expr is List)) + { + return expr; // is a constant literal + } + else + { + List exprList = (List)expr; + if (Symbol.QUOTE.Equals(exprList[0])) + { + return exprList[1]; + } + else if (Symbol.IF.Equals(exprList[0])) + { + var test = exprList[1]; + var conseq = exprList[2]; + var alt = exprList[3]; + expr = ConvertToBool(EvaluateExpression(test, env)) ? conseq : alt; + } + else if (Symbol.DEFINE.Equals(exprList[0])) + { + var variable = (Symbol)exprList[1]; + expr = exprList[2]; + env[variable] = EvaluateExpression(expr, env); + return None.Instance; // TODO: what's the return type of define? + } + else if (Symbol.SET.Equals(exprList[0])) + { + var sym = (Symbol)exprList[1]; + var containingEnv = env.TryFindContainingEnv(sym); + if (containingEnv == null) + { + throw new KeyNotFoundException("Symbol not defined: " + sym); + } + + containingEnv[sym] = EvaluateExpression(exprList[2], env); + return None.Instance; + } + else if (Symbol.LAMBDA.Equals(exprList[0])) + { + Union> parameters; + if (exprList[1] is Symbol) + { + parameters = new Union>((Symbol)exprList[1]); + } + else + { + parameters = new Union>(((List)exprList[1]).Cast().ToList()); + } + + return new Procedure(parameters, exprList[2], env); + } + else if (Symbol.BEGIN.Equals(exprList[0])) + { + for (int i = 1; i < exprList.Count - 1 /* don't eval last expr yet */; i++) + { + EvaluateExpression(exprList[i], env); + } + + expr = exprList[exprList.Count - 1]; // tail call optimization + } + else + { + // a procedure call + var rawProc = EvaluateExpression(exprList[0], env); + if (!(rawProc is ICallable)) + { + throw new InvalidCastException(string.Format("Object is not callable: {0}", rawProc)); + } + + var args = exprList.Skip(1).Select(a => EvaluateExpression(a, env)).ToList(); + if (rawProc is Procedure) + { + // Tail call optimization - instead of evaluating the procedure here which grows the + // stack by calling EvaluateExpression, we update the `expr` and `env` to be the + // body and the (params, args), and loop the evaluation from here. + var proc = (Procedure)rawProc; + expr = proc.Body; + env = Environment.FromVariablesAndValues(proc.Parameters, args, proc.Env); + } + else if (rawProc is NativeProcedure) + { + return ((NativeProcedure)rawProc).Call(args); + } + else + { + throw new InvalidOperationException("unexpected implementation of ICallable: " + rawProc.GetType().Name); + } + } + } + } + } + + private static bool IsPair(object x) + { + return x is List && ((List)x).Count > 0; + } + + private static object ExpandQuasiquote(object x) + { + if (!IsPair(x)) return new List { Symbol.QUOTE, x }; + var xs = (List)x; + Utils.CheckSyntax(xs, !Symbol.UNQUOTE_SPLICING.Equals(xs[0]), "Cannot splice"); + if (Symbol.UNQUOTE.Equals(xs[0])) + { + Utils.CheckSyntax(xs, xs.Count == 2); + return xs[1]; + } + else if (IsPair(xs[0]) && Symbol.UNQUOTE_SPLICING.Equals(((List)xs[0])[0])) + { + var x0 = (List)xs[0]; + Utils.CheckSyntax(x0, x0.Count == 2); + return new List { Symbol.APPEND, x0[1], ExpandQuasiquote(xs.Skip(1).ToList()) }; + } + else + { + return new List { Symbol.CONS, ExpandQuasiquote(xs[0]), ExpandQuasiquote(xs.Skip(1).ToList()) }; + } + } + + private static object ParseAtom(string token) + { + int intVal; + double floatVal; + if (token == "#t") + { + return true; + } + else if (token == "#f") + { + return false; + } + else if (token[0] == '"') + { + return token.Substring(1, token.Length - 2); + } + else if (int.TryParse(token, out intVal)) + { + return intVal; + } + else if (double.TryParse(token, out floatVal)) + { + return floatVal; + } + else + { + return Symbol.FromString(token); // a symbol + } + } + + private static bool ConvertToBool(object val) + { + if (val is bool) return (bool)val; + return true; + } + + public struct EvaluationResult + { + private readonly Exception error; + private readonly object result; + + public EvaluationResult(Exception error, object result) : this() + { + this.error = error; + this.result = result; + } + + public Exception Error { get { return this.error; } } + + public object Result { get { return this.result; } } + } + + public class InPort + { + private const string tokenizer = @"^\s*(,@|[('`,)]|""(?:[\\].|[^\\""])*""|;.*|[^\s('""`,;)]*)(.*)"; + + private TextReader file; + private string line; + + public InPort(TextReader file) + { + this.file = file; + this.line = string.Empty; + } + + /// + /// Parses and returns the next token. Returns if there's no more content to read. + /// + public object NextToken() + { + while (true) + { + if (this.line == string.Empty) + { + this.line = this.file.ReadLine(); + } + + if (this.line == string.Empty) + { + continue; + } + else if (this.line == null) + { + return Symbol.EOF; + } + else + { + var res = Regex.Match(this.line, tokenizer); + var token = res.Groups[1].Value; + this.line = res.Groups[2].Value; + + if (string.IsNullOrEmpty(token)) + { + // 1st group is empty. All string falls into 2nd group. This usually means + // an error in the syntax, e.g., incomplete string "foo + var tmp = this.line; + this.line = string.Empty; // to continue reading next line + + if (tmp.Trim() != string.Empty) + { + // this is a syntax error + Utils.CheckSyntax(tmp, false, "unexpected syntax"); + } + } + + if (!string.IsNullOrEmpty(token) && !token.StartsWith(";")) + { + return token; + } + } + } + } + } + } +} + diff --git a/src/schemy/Symbol.cs b/src/schemy/Symbol.cs new file mode 100644 index 0000000..f4db239 --- /dev/null +++ b/src/schemy/Symbol.cs @@ -0,0 +1,107 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace Schemy +{ + using System; + using System.Collections.Generic; + + /// + /// Scheme symbol + /// + /// + /// Symbols are interned so that symbols with the same name are actually of the same symbol object instance. + /// + public class Symbol : IEquatable + { + private static readonly IDictionary table = new Dictionary(); + public static readonly IReadOnlyDictionary QuotesMap = new Dictionary() + { + { "'", Symbol.QUOTE }, + { "`", Symbol.QUASIQUOTE}, + { ",", Symbol.UNQUOTE}, + { ",@", Symbol.UNQUOTE_SPLICING}, + }; + + private readonly string symbol; + + /// + /// Initializes a new instance of the class. + /// + /// The symbol + /// + /// This is private and the users should call to instantiate a symbol object. + /// + private Symbol(string sym) + { + this.symbol = sym; + } + + public string AsString + { + get { return this.symbol; } + } + + /// + /// Returns the interned symbol + /// + /// The symbol name + /// the symbol instance + public static Symbol FromString(string sym) + { + Symbol res; + if (!table.TryGetValue(sym, out res)) + { + table[sym] = new Symbol(sym); + } + + return table[sym]; + } + + #region wellknown symbols + public static Symbol IF { get { return Symbol.FromString("if"); } } + public static Symbol QUOTE { get { return Symbol.FromString("quote"); } } + public static Symbol SET { get { return Symbol.FromString("set!"); } } + public static Symbol DEFINE { get { return Symbol.FromString("define"); } } + public static Symbol LAMBDA { get { return Symbol.FromString("lambda"); } } + public static Symbol BEGIN { get { return Symbol.FromString("begin"); } } + public static Symbol DEFINE_MACRO { get { return Symbol.FromString("define-macro"); } } + public static Symbol QUASIQUOTE { get { return Symbol.FromString("quasiquote"); } } + public static Symbol UNQUOTE { get { return Symbol.FromString("unquote"); } } + public static Symbol UNQUOTE_SPLICING { get { return Symbol.FromString("unquote-splicing"); } } + public static Symbol EOF { get { return Symbol.FromString("#"); } } + public static Symbol APPEND { get { return Symbol.FromString("append"); } } + public static Symbol CONS { get { return Symbol.FromString("cons"); } } + #endregion wellknown symbols + + #region object implementations + public override bool Equals(object obj) + { + if (obj == null) return false; + if (obj is Symbol) + { + return object.Equals(this.symbol, ((Symbol)obj).symbol); + } + else + { + return false; + } + } + + public override string ToString() + { + return string.Format("'{0}", this.symbol); + } + + public override int GetHashCode() + { + return this.symbol.GetHashCode(); + } + + public bool Equals(Symbol other) + { + return ((object)this).Equals(other); + } + #endregion object implementations + } +} diff --git a/src/schemy/Utils.cs b/src/schemy/Utils.cs new file mode 100644 index 0000000..0129647 --- /dev/null +++ b/src/schemy/Utils.cs @@ -0,0 +1,92 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace Schemy +{ + using System; + using System.Collections.Generic; + using System.Linq; + + public static class Utils + { + /// + /// Checks the arity of input arguments of a procedure + /// + /// The arguments. + /// The acceptable arity. + /// thrown when that number of args doesn't match the expected arity. + public static void CheckArity(List args, params int[] acceptableArities) + { + if (!acceptableArities.Contains(args.Count)) + { + throw new SyntaxError(string.Format("Arity mismatch. Expecting {0}, Got {1}", string.Join(" or ", acceptableArities), args.Count)); + } + } + + /// + /// Throws if the syntax check is not successful, and prints the expression for diagnostics. + /// + /// The expr that's being checked + /// if the syntax check was successful + /// The error message + /// thrown when the syntax check was failed. + public static void CheckSyntax(object expr, bool success, string msg = null) + { + msg = msg ?? "Syntax error"; + if (!success) + { + throw new SyntaxError(string.Format("{0}: {1}", msg, Utils.PrintExpr(expr))); + } + } + + /// + /// Converts the type of the input to the desired type + /// + /// desired target type + /// The input value. + /// the object of the target type + /// thrown when the conversion is not possible + /// + /// This is needed because the regular casting can't handle some implicit convert when going through boxing/unboxing, e.g., int to object to double. + /// + public static T ConvertType(object val) + { + if (val is T) return (T)val; + + // object x = 2; + // double y = (double)x; // <-- this would fail. + try + { + return (T)System.Convert.ChangeType(val, typeof(T)); + } + catch + { + throw new InvalidOperationException(string.Format("Cannot convert {0} to type {1}", Utils.PrintExpr(val), typeof(T).Name)); + } + } + + public static string PrintExpr(object x) + { + if (x is bool) + { + return (bool)x ? "#t" : "#f"; + } + else if (x is Symbol) return ((Symbol)x).AsString; + else if (x is string) return string.Format(@"""{0}""", x); + else if (x is List) return string.Format("({0})", string.Join(" ", ((List)x).Select(a => PrintExpr(a)))); + else if (x == null) return string.Empty; + else return x.ToString(); + } + + /// + /// Converts a binary operator (function) to the variadic version. + /// + /// + /// Given a summing function `sum(x, y) => result`. It creates a variadic version: `sum(x, y, ...) => result`. + /// + public static Func, object> MakeVariadic(Func func) + { + return args => args.Aggregate(func); + } + } +} \ No newline at end of file diff --git a/src/schemy/init.ss b/src/schemy/init.ss new file mode 100644 index 0000000..2ca00c0 --- /dev/null +++ b/src/schemy/init.ss @@ -0,0 +1,22 @@ +(define-macro let + (lambda args + (define specs (car args)) ; ( (var1 val1), ... ) + (define bodies (cdr args)) ; (expr1 ...) + (if (null? specs) + `((lambda () ,@bodies)) + (begin + (define spec1 (car specs)) ; (var1 val1) + (define spec_rest (cdr specs)) ; ((var2 val2) ...) + (define inner `((lambda ,(list (car spec1)) ,@bodies) ,(car (cdr spec1)))) + `(let ,spec_rest ,inner))))) + +(define-macro cond + (lambda args + (if (= 0 (length args)) ''() + (begin + (define first (car args)) + (define rest (cdr args)) + (define test1 (if (equal? (car first) 'else) '#t (car first))) + (define expr1 (car (cdr first))) + `(if ,test1 ,expr1 + (cond ,@rest)))))) diff --git a/src/schemy/schemy.csproj b/src/schemy/schemy.csproj new file mode 100644 index 0000000..9149780 --- /dev/null +++ b/src/schemy/schemy.csproj @@ -0,0 +1,69 @@ + + + + + Debug + AnyCPU + {E54139B7-CB81-4883-B8CD-40BAB5420EB8} + Library + Properties + Schemy + schemy + v4.5.2 + 512 + true + + + AnyCPU + true + full + false + bin\Debug\ + DEBUG;TRACE + prompt + 4 + + + AnyCPU + pdbonly + true + bin\Release\ + TRACE + prompt + 4 + + + + + + + + + + + + + + + + + + + + + + + + + init.ss + + + + + \ No newline at end of file diff --git a/src/test/Program.cs b/src/test/Program.cs new file mode 100644 index 0000000..7c04fb5 --- /dev/null +++ b/src/test/Program.cs @@ -0,0 +1,27 @@ +// Copyright (c) Microsoft Corporation. All rights reserved. +// Licensed under the MIT License. + +namespace test +{ + using System; + using System.IO; + using Schemy; + + class Program + { + static void Main(string[] args) + { + var interpreter = new Interpreter(fsAccessor: new ReadOnlyFileSystemAccessor()); + using (var reader = new StreamReader(File.OpenRead("tests.ss"))) + { + var result = interpreter.Evaluate(reader); + if (result.Error != null) + { + throw new InvalidOperationException(string.Format("Test Error: {0}", result.Error)); + } + } + + Console.WriteLine("Tests were successful"); + } + } +} diff --git a/src/test/test.csproj b/src/test/test.csproj new file mode 100644 index 0000000..093ebe9 --- /dev/null +++ b/src/test/test.csproj @@ -0,0 +1,95 @@ + + + + + Debug + AnyCPU + {4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6} + Exe + Properties + test + test + v4.5.2 + 512 + true + publish\ + true + Disk + false + Foreground + 7 + Days + false + false + true + 0 + 1.0.0.%2a + false + false + true + + + AnyCPU + true + full + false + bin\Debug\ + DEBUG;TRACE + prompt + 4 + + + AnyCPU + pdbonly + true + bin\Release\ + TRACE + prompt + 4 + + + + + + + + + + + + + + + + + {e54139b7-cb81-4883-b8cd-40bab5420eb8} + schemy + + + + + False + Microsoft .NET Framework 4.5.2 %28x86 and x64%29 + true + + + False + .NET Framework 3.5 SP1 + false + + + + + + + + copy $(ProjectDir)\tests.ss $(TargetDir)\tests.ss + + + \ No newline at end of file diff --git a/src/test/test.csproj.user b/src/test/test.csproj.user new file mode 100644 index 0000000..8221333 --- /dev/null +++ b/src/test/test.csproj.user @@ -0,0 +1,13 @@ + + + + publish\ + + + + + + en-US + false + + \ No newline at end of file diff --git a/src/test/test.sln b/src/test/test.sln new file mode 100644 index 0000000..a891aac --- /dev/null +++ b/src/test/test.sln @@ -0,0 +1,22 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +# Visual Studio 14 +VisualStudioVersion = 14.0.25420.1 +MinimumVisualStudioVersion = 10.0.40219.1 +Project("{FAE04EC0-301F-11D3-BF4B-00C04F79EFBC}") = "test", "test.csproj", "{4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Release|Any CPU = Release|Any CPU + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}.Debug|Any CPU.Build.0 = Debug|Any CPU + {4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}.Release|Any CPU.ActiveCfg = Release|Any CPU + {4A62A84F-58AA-4D1C-AA7C-D3CDF0C3FFA6}.Release|Any CPU.Build.0 = Release|Any CPU + EndGlobalSection + GlobalSection(SolutionProperties) = preSolution + HideSolutionNode = FALSE + EndGlobalSection +EndGlobal diff --git a/src/test/tests.ss b/src/test/tests.ss new file mode 100644 index 0000000..7821c2d --- /dev/null +++ b/src/test/tests.ss @@ -0,0 +1,147 @@ +;; ============ +;; DEFINE TESTS +;; ============ + +;; ------------ +;; Simple tests +;; ------------ +(define simple-tests + (list + `(,(+ 1 2) 3) + `(,(- 2 1) 1) + `(,(* 2 3) 6) + `(,(/ 4 3) 1) + `(,(= 1 1) #t) + `(,(= 1 2) #f) + `(,(< 1 2) #t) + `(,(> 1 2) #f) +)) + + +;; ----------- +;; Test syntax +;; ----------- +(define (test-syntax) + (define x 1) + (assert (= x 1)) + + (define f (lambda (x) (+ x 1))) + (assert (= 2 (f 1))) + + ;; Tests lambda definition and lexical scoping + ;; `create-student` implements a minimum "struct" by using lexical variable + ;; scoping. It is a function that returns a list of three functions: + ;; 1. a function that returns the (name age) + ;; 2. a function that sets the student's name + ;; 3. a function that sets the student's age + (define (create-student name age) + (define (get-student) (list name age)) + (define (set-name! v) (set! name v)) + (define (set-age! v) (set! age v)) + (list get-student set-name! set-age!)) + + (define john (create-student "john" 18)) + (define mike (create-student "mike" 22)) + + (assert (equal? '("john" 18) ((list-ref john 0)))) + ((list-ref john 2) 19) ; set john's age to 19 + (assert (equal? '("john" 19) ((list-ref john 0)))) + (assert (equal? '("mike" 22) ((list-ref mike 0)))) + + ;; Test proper tail recursion + (define (sum-up-to n acc) + (if (= n 0) acc + (sum-up-to (- n 1) (+ acc n)))) + (assert (= 1250025000 (sum-up-to 50000 0)) "test proper tail recursion") +) ; test-syntax + + +;; ---------------------------- +;; Test list related operations +;; ---------------------------- +(define (test-list) + ; test list is correctly constructed + ; test `car` and `cdr` + (define ls (list 1 2 3 4)) + (assert (list? ls)) + (assert (not (list? 1))) + (assert (= 4 (length ls))) + (assert (= (car ls) 1)) + (assert (= (car (cdr ls)) 2)) + (assert (= (car (cdr (cdr ls))) 3)) + (assert (= (car (cdr (cdr (cdr ls)))) 4)) + + ; test list literal + (define ls2 '(1 2 3 4)) + + ; test list operations + (assert (equal? ls ls2)) + (assert (equal? ls (range 1 5))) + (assert (null? (list))) + (assert (not (null? (list 1)))) + (assert (= 0 (length (list)))) + + ; test list reversion + (define lsr '(4 3 2 1)) + (assert (equal? (reverse ls) lsr)) + + ; test `map` + (define (double x) (* x 2)) + (assert (equal? `(2 4 6 8) (map double ls))) +) ; test-list + + +;; ---------- +;; Test macro +;; ---------- +(define-macro let + (lambda args + (define specs (car args)) ; ((var1 val1), ...) + (define bodies (cdr args)) ; (expr1 ...) + (if (null? specs) + `((lambda () ,@bodies)) + (begin + (define spec1 (car specs)) ; (var1 val1) + (define spec_rest (cdr specs)) ; ((var2 val2) ...) + (define inner `((lambda ,(list (car spec1)) ,@bodies) ,(car (cdr spec1)))) + `(let ,spec_rest ,inner))))) + +(define (test-macro) + ; test the `let` macro + (define x + (let ((a 4) + (b (+ 2 3))) + (* a b))) + (assert (= 20 x))) + + +;; ========= +;; RUN TESTS +;; ========= + +;; run tests in ((actual, expected) ... ) +(define (test specs) + (if (null? specs) + #t + (begin + (define head (car specs)) + (assert (equal? (car head) (car (cdr head)))) + (test (cdr specs))))) +(test simple-tests) + +(test-list) +(test-syntax) +(test-macro) + + +;; ======================= +;; Interpreter integration +;; ======================= + +; Test those global variables are accessible from interpreter environment table +; and that the interpreter can invoke the procedure to get the correct result. +(define ANSWER-TO-THE-ULTIMATE-QUESTION-OF-LIFE-UNIVERSE-AND-EVERYTHING 42) +(define (TIMES-TWO x) (* 2 x)) + +; Test that the last value is the return result of the interpreter +"good bye" diff --git a/tools/transform_source.rkt b/tools/transform_source.rkt new file mode 100644 index 0000000..4b1b3eb --- /dev/null +++ b/tools/transform_source.rkt @@ -0,0 +1,45 @@ +#| +This script evaluates a script file to transform input file content. The transformed output +is displayed to stdout. + +This is currently broken because racket IO APIs doesn't strip BOM at the beginning of the file +|# + +#lang at-exp racket + +(require web-server/templates + racket/cmdline) + +(define template-file (make-parameter "")) +(define input-file (make-parameter "")) + +(command-line + #:once-each + [("-t" "--template") template + "template file to use. `FILENAME` and `INPUT` variables are available to the template" + (template-file template)] + #:args (input) + (input-file input)) + +#| +(define (read-content fn) + (define lines (port->lines (open-input-file #:mode 'text (input-file)))) + (string-join lines "\n")) +|# + +(define (read-content fn) + (port->string (open-input-file fn)) + ) + +(define INPUT (read-content (input-file))) +(define FILENAME (path->string (file-name-from-path (input-file)))) + +(define ns (make-base-namespace)) +(namespace-set-variable-value! 'INPUT INPUT #f ns) +(namespace-set-variable-value! 'FILENAME FILENAME #f ns) + +(void + (write-string + (eval + (read + (open-input-file (template-file))) ns))) \ No newline at end of file