also show scheme code in web playground

Makefile

@@ -28,9 +28,15 @@ newt.ss: newt.js
 newt.so: newt.ss prim.ss
 	chez --script scripts/compile-chez.ss
 
+newt2.ss: newt.so
+	chez --program newt.ss src/Main.newt -o newt2.ss
+
 test: newt.js
 	scripts/test
 
+cheztest: newt.so
+	make test NEWT='chez --program newt.so' RUNOUT="chez --script" OUTFILE=tmp/out.ss
+
 aoctest: newt.js
 	scripts/aoc
 	scripts/aoc25

playground/src/cmeditor.ts

@@ -154,6 +154,36 @@ const newtLanguage2: StreamLanguage<State> = StreamLanguage.define({
   },
 });
 
+export function scheme() {
+  return new LanguageSupport(schemeLanguage);
+}
+
+const schemeLanguage: StreamLanguage<State> = StreamLanguage.define({
+  startState: () => null,
+  token(stream, st) {
+    const keywords = ["define", "let", "case", "cond", "import", "include", "lambda", "else"];
+    if (stream.eatSpace()) return null;
+    if (stream.match("--")) {
+      stream.skipToEnd();
+      return "comment";
+    }
+    if (stream.match(/[0-9A-Za-z!%&*+./:<=>?@^_~-]+/)) {
+      let word = stream.current();
+      if (keywords.includes(word)) return "keyword";
+      return null;
+    }
+    // unhandled
+    stream.next();
+    return null
+  },
+  languageData: {
+    commentTokens: {
+      line: ";;",
+    },
+    wordChars: "!%&*+-./:<=>?@^_~",
+  },
+});
+
 function newt() {
   return new LanguageSupport(newtLanguage2);
 }

playground/src/ipc.ts

@@ -49,7 +49,7 @@ export interface API {
   hoverInfo(fileName: string, row: number, col: number): HoverResult | boolean | null;
   codeActionInfo(fileName: string, row: number, col: number): CodeAction[] | null;
   // we need to add this to the LSP build
-  compile(fileName: string):  string;
+  compile(fileName: string, language: 'javascript'|'scheme'):  string;
 }
 
 export interface Message<K extends keyof API> {
@@ -116,4 +116,3 @@ export class IPC {
   }
 }
 
-class IPCClient {}

playground/src/main.ts

@@ -11,12 +11,12 @@ import {
   TopData,
   Marker,
 } from "./types.ts";
-import { CMEditor } from "./cmeditor.ts";
+import { CMEditor, scheme } from "./cmeditor.ts";
 import { deflate } from "./deflate.ts";
 import { inflate } from "./inflate.ts";
 import { IPC, Position } from "./ipc.ts";
 import helpText from "./help.md?raw";
-import { basicSetup, EditorView } from "codemirror";
+import { basicSetup, EditorView} from "codemirror";
 import {Compartment, EditorState} from "@codemirror/state";
 import { javascript } from "@codemirror/lang-javascript";
 import { oneDark } from "@codemirror/theme-one-dark";
@@ -82,11 +82,23 @@ if (!state.javascript.value) {
     const fileName = state.currentFile.value;
     // maybe send fileName, src?
     await ipc.sendMessage("updateFile", [fileName, src]);
-    let js = await ipc.sendMessage("compile", [fileName]);
+    let js = await ipc.sendMessage("compile", [fileName, "javascript"]);
     state.javascript.value = bundle(js);
   }
 }
 
+async function refreshScheme() {
+if (!state.scheme.value) {
+    let src = state.editor.value!.getValue();
+    console.log("SEND TO", iframe.contentWindow);
+    const fileName = state.currentFile.value;
+    // maybe send fileName, src?
+    await ipc.sendMessage("updateFile", [fileName, src]);
+    let scheme = await ipc.sendMessage("compile", [fileName, "scheme"]);
+    state.scheme.value = bundle(scheme);
+  }
+}
+
 async function runOutput() {
   await refreshJS()
   const src = state.javascript.value;
@@ -153,15 +165,23 @@ function getSavedCode() {
   return value;
 }
 
+const RESULTS = "Output";
+const JAVASCRIPT = "JS";
+const SCHEME = "Scheme";
+const CONSOLE = "Console";
+const HELP = "Help";
+
 const state = {
   output: signal(""),
   toast: signal(""),
   javascript: signal(""),
+  scheme: signal(""),
   messages: signal<string[]>([]),
   editor: signal<AbstractEditor | null>(null),
   dark: signal(false),
   files: signal<string[]>(["Tour.newt"]),
   currentFile: signal<string>(localStorage.currentFile ?? "Tour.newt"),
+  selected: signal(localStorage.tab ?? RESULTS),
 };
 
 // Monitor dark mode state (TODO - let user override system setting)
@@ -264,7 +284,12 @@ const language: EditorDelegate = {
       }
       setOutput(res.output)
       // less flashy version
-      ipc.sendMessage("compile", [fileName]).then(js => state.javascript.value = bundle(js));
+      if (state.selected.value === JAVASCRIPT)
+        ipc.sendMessage("compile", [fileName, "javascript"]).then(js => state.javascript.value = bundle(js));
+      if (state.selected.value === SCHEME)
+        ipc.sendMessage("compile", [fileName, "scheme"]).then(scheme=> state.scheme.value = scheme);
+      // UI will update
+      state.scheme.value = "";
       return diags;
     } catch (e) {
       console.log("ERR", e);
@@ -287,26 +312,26 @@ function Editor({ initialValue }: EditorProps) {
   return h("div", { id: "editor", ref });
 }
 
-// for extra credit, we could have a read-only monaco
-function JavaScript() {
-  const text = state.javascript.value;
+interface ViewerProps {
+  language: 'javascript' | 'scheme'
+}
+function SourceViewer({language}: ViewerProps) {
+  const text = state[language].value;
 
   // return h("div", { id: "javascript" }, text);
   const ref = useRef<HTMLDivElement>(null);
   const editorView = useRef<EditorView>(null);
   const themeRef = useRef<Compartment>(null);
   useEffect(() => {
-    console.log('JSEFFECT')
     const container = ref.current!;
     themeRef.current = new Compartment();
-
     const editor = new EditorView({
       doc: text,
       parent: container,
       extensions: [
         basicSetup,
         themeRef.current.of(state.dark.value ? oneDark : EditorView.baseTheme({})),
-        javascript(),
+        language == 'javascript' ? javascript() : scheme(),
         EditorState.readOnly.of(true),
         EditorView.editable.of(false),
       ],
@@ -347,16 +372,11 @@ function Console() {
   );
 }
 
-const RESULTS = "Output";
-const JAVASCRIPT = "JS";
-const CONSOLE = "Console";
-const HELP = "Help";
-
 function Tabs() {
-  const [selected, setSelected] = useState(localStorage.tab ?? RESULTS);
+  const selected = state.selected.value
   const Tab = (label: string) => {
     let onClick = () => {
-      setSelected(label);
+      state.selected.value = label;
       localStorage.tab = label;
     };
     let className = "tab";
@@ -365,20 +385,24 @@ function Tabs() {
   };
 
   useEffect(() => {
-    if (state.messages.value.length) setSelected(CONSOLE);
+    if (state.messages.value.length) state.selected.value = CONSOLE;
   }, [state.messages.value]);
 
   useEffect(() => {
     if (selected === JAVASCRIPT && !state.javascript.value) refreshJS();
-  }, [selected, state.javascript.value]);
+    if (selected === SCHEME && !state.scheme.value) refreshScheme();
+  }, [selected, state.javascript.value, state.scheme.value]);
 
   let body;
   switch (selected) {
     case RESULTS:
       body = h(Result, {});
       break;
+    case SCHEME:
+      body = h(SourceViewer, {language: 'scheme'});
+      break;
     case JAVASCRIPT:
-      body = h(JavaScript, {});
+      body = h(SourceViewer, {language:'javascript'});
       break;
     case CONSOLE:
       body = h(Console, {});
@@ -398,6 +422,7 @@ function Tabs() {
       { className: "tabBar" },
       Tab(RESULTS),
       Tab(JAVASCRIPT),
+      Tab(SCHEME),
       Tab(CONSOLE),
       Tab(HELP),
     ),

playground/src/newt.d.ts

@@ -5,3 +5,4 @@ export function LSP_checkFile(name: string): Diagnostic[];
 export function LSP_hoverInfo(name: string, row: number, col: number): HoverResult | boolean | null;
 export function LSP_codeActionInfo(name: string, row: number, col: number): CodeAction[] | null;
 export function LSP_compileJS(name: string): string;
+export function LSP_compileToScheme(name: string): string;

playground/src/worker.ts

@@ -1,7 +1,7 @@
 import { shim } from "./emul";
 import { API, Message, ResponseMSG } from "./ipc";
 import { archive, preload } from "./preload";
-import { LSP_checkFile, LSP_codeActionInfo, LSP_compileJS, LSP_hoverInfo, LSP_updateFile } from './newt';
+import { LSP_checkFile, LSP_codeActionInfo, LSP_compileJS, LSP_compileToScheme, LSP_hoverInfo, LSP_updateFile } from './newt';
 
 const LOG = console.log
 
@@ -25,7 +25,10 @@ const api: API = {
   },
   hoverInfo: LSP_hoverInfo,
   codeActionInfo: LSP_codeActionInfo,
-  compile: LSP_compileJS,
+  compile: (fn, lang) => {
+    if (lang == 'scheme') return LSP_compileToScheme(fn);
+    return LSP_compileJS(fn);
+  }
 }
 
 const handleMessage = async function <K extends keyof API>(ev: { data: Message<K> }) {

prim.ss

@@ -1,6 +1,3 @@
-;; REVIEW all of this - some of it is IO and needs the IO dance
-;; maybe we make a helper? A macro?
-
 ; (define $IORes (lambda (nm-1 nm-2) (vector 0 #f nm-1 nm-2)))
 (define $IORes (lambda (nm-1 nm-2) (cons nm-1 nm-2)))
 (define ($Left x) (vector 0 #f #f x))
@@ -17,7 +14,6 @@
 (define (Prelude.ltString a b) (string<? a b))
 (define (Prelude.eqString a b) (string=? a b))
 (define Prelude.showInt number->string)
-(define (Node.exitFailure _ msg) (raise msg))
 (define (Prelude.primPutStrLn msg)
   (lambda (w)
     (display msg)
@@ -73,7 +69,12 @@
 (define (Prelude.subInt a b) (- a b))
 (define (Prelude.jsEq _ a b) (= a b))
 (define (Prelude.divInt a b) (fx/ a b))
-(define (Prelude.fatalError _ msg) (raise msg))
+;; In node this throws and the next one exits cleanly
+(define (Prelude.fatalError _ msg) (raise (error #f msg)))
+(define (Node.exitFailure _ msg)
+  (display msg)
+  (newline)
+  (exit 1))
 (define (Prelude.isSuffixOf sfx s)
   (let ((n (string-length sfx))
         (m (string-length s)))
@@ -81,3 +82,5 @@
         (string=? sfx (substring s (- m n) m))
         #f)))
 (define (Node.getArgs w) ($IORes (command-line) w))
+(define (Prelude.unsafePerformIO a f)
+  (car (f 'world)))

scripts/test

@@ -1,7 +1,10 @@
 #!/bin/sh
 SAMPLES=$(find playground/samples -name "*.newt")
-# NCC="bun run newt.js"
-NCC="node newt.js"
+# NEWT ="bun run newt.js"
+NEWT=${NEWT:="node newt.js"}
+OUTFILE=${OUTFILE:="tmp/out.js"}
+RUNOUT=${RUNOUT:="node"}
+mkdir -p tmp
 total=0
 failed=0
 for fn in tests/*.newt ; do
@@ -9,10 +12,10 @@ for fn in tests/*.newt ; do
   echo Test $fn
   bn=$(basename $fn)
   if [ -f ${fn}.golden ]; then
-    $NCC $fn -o out.js > tmp/${bn}.compile
+    $NEWT $fn -o $OUTFILE > tmp/${bn}.compile
   else
     # we've dropped support for compiling things without main for now.
-    $NCC $fn > tmp/${bn}.compile
+    $NEWT $fn > tmp/${bn}.compile
   fi
   cerr=$?
   if [ -f ${fn}.fail ]; then
@@ -34,7 +37,7 @@ for fn in tests/*.newt ; do
   fi
   # if there is a golden file, run the code and compare output
   if [ -f ${fn}.golden ]; then
-    node out.js > tmp/${bn}.out
+    $RUNOUT $OUTFILE > tmp/${bn}.out
     if [ $? != "0" ]; then
       echo Run failed for $fn
       failed=$((failed + 1))

src/LSP.newt

@@ -17,6 +17,7 @@ import Lib.ProcessDecl
 import Lib.Prettier
 import Lib.Error
 import Lib.CompileJS
+import Lib.CompileScheme
 
 pfunc js_castArray : Array JSObject → JSObject := `x => x`
 pfunc js_castInt : Int → JSObject := `x => x`
@@ -278,7 +279,6 @@ compileJS fn = unsafePerformIO $ do
   when (st.baseDir /= base) $ \ _ => resetState base
   repo <- lspFileSource
   (Right (top, src)) <- (do
-    putStrLn "woo"
     mod <- processModule emptyFC repo Nil modName
     docs <- compile
     let src = unlines $
@@ -290,4 +290,19 @@ compileJS fn = unsafePerformIO $ do
   modifyIORef state [ topContext := top ]
   pure $ js_castStr src
 
-#export updateFile checkFile hoverInfo codeActionInfo compileJS docSymbols
+compileToScheme : String → JSObject
+compileToScheme fn = unsafePerformIO $ do
+  let (base, modName) = decomposeName fn
+  st <- readIORef state
+  when (st.baseDir /= base) $ \ _ => resetState base
+  repo <- lspFileSource
+  (Right (top, src)) <- (do
+    mod <- processModule emptyFC repo Nil modName
+    docs <- compileScheme
+    let src = unlines docs
+    pure src).runM st.topContext
+    | Left err => pure $ js_castStr ";; \{errorMsg err}"
+  modifyIORef state [ topContext := top ]
+  pure $ js_castStr src
+
+#export updateFile checkFile hoverInfo codeActionInfo compileJS docSymbols compileToScheme

src/Lib/CompileJS.newt

@@ -313,6 +313,8 @@ termToJS {e} env (CCase t alts) f =
     maybeCaseStmt env sc (CDefAlt u :: Nil) = (termToJS env u f)
     -- If there is a single alt, assume it matched
     maybeCaseStmt env sc ((CConAlt _ _ info args qs u) :: Nil) = (termToJS (conAltEnv sc 0 env args) u f)
+    maybeCaseStmt env sc alts@(CLitAlt _ u :: Nil) = termToJS env u f
+    maybeCaseStmt env sc alts@(CDefAlt u :: Nil) = termToJS env u f
     maybeCaseStmt env sc alts@(CLitAlt _ _  :: _) =
         (JCase sc (map (termToJSAlt env sc) alts))
     maybeCaseStmt env sc alts = case alts of

src/Lib/CompileScheme.newt

@@ -85,8 +85,9 @@ cexpToScm env (CFun args body) = case bindAll args Lin env  of
   where
     bindAll : List (Quant × String) → SnocList String → SCEnv → List String × SCEnv
     bindAll Nil acc env = (acc <>> Nil, env)
-    bindAll ((_,nm) :: rest) acc env = case scbind nm env of
+    bindAll ((Many,nm) :: rest) acc env = case scbind nm env of
       (nm', env') => bindAll rest (acc :< nm') env'
+    bindAll ((Zero,nm) :: rest) acc env = bindAll rest acc ("#f" :: env)
 cexpToScm env (CApp t u) = "(\{cexpToScm env t} \{cexpToScm env u})"
 cexpToScm env (CAppRef nm args Nil) = go (scmName nm) $ map (cexpToScm env) args
   where
@@ -106,7 +107,8 @@ cexpToScm env (CAppRef nm args quants) =
     go env acc Nil (q :: qs) = case scbind "_" env of
       (nm, env') => let acc = "\{acc} \{nm}" in "(lambda (\{nm}) \{go env' acc Nil qs})"
     -- TODO / REVIEW Only for Many?
-    go env acc (arg :: args) (q :: qs) = go env "\{acc} \{arg}" args qs
+    go env acc (arg :: args) (Many :: qs) = go env "\{acc} \{arg}" args qs
+    go env acc (arg :: args) (Zero :: qs) = go env acc args qs
     -- go env acc (arg :: args) (q :: qs) = go env acc args qs
 -- so... we're not giving scrutinee a deBruijn index, but we may
 -- need to let it so we can pull data off for the CConAlt
@@ -170,6 +172,8 @@ cexpToScm env (CCase sc alts) = do
         (CLitAlt _ _ :: _) => fatalError "lit alt after nil"
         _ => fatalError "too many alts after cons"
     doCase nm (CConAlt tag cname _ args qs body :: Nil) = conAlt env nm Lin args body
+    doCase nm (CLitAlt _ body :: Nil) = cexpToScm env body
+    doCase nm (CDefAlt body :: Nil) = cexpToScm env body
     doCase nm alts@(CLitAlt _ _ :: _) = "(case \{nm} \{joinBy " " $ map (doAlt nm) alts})"
     --
     doCase nm alts = "(case (vector-ref \{cexpToScm env sc} 0) \{joinBy " " $ map (doAlt nm) alts})"

src/Lib/ProcessModule.newt

@@ -186,5 +186,7 @@ invalidateModule modname = do
     go : SortedMap String (List String) → List String → SortedMap String ModContext → SortedMap String ModContext
     go deps Nil mods = mods
     go deps (name :: names) mods =
+      -- Have we hit this name already?
+      let (Just _) = lookupMap name mods | _ => go deps names mods in
       let ds = fromMaybe Nil $ lookupMap' name deps in
       go deps (ds ++ names) (deleteMap name mods)