From 97817711d3eebaacc354a77aa83bc9544cc87d42 Mon Sep 17 00:00:00 2001
From: Akshay Nair <phenax5@gmail.com>
Date: Sat, 14 Jan 2023 11:26:56 +0530
Subject: feat: adds bindto with scopes

---
 examples/file.ts         | 19 ++++++++++++++++---
 src/context.ts           | 23 +++++++++++++++++++++++
 src/eval-env/builtins.ts | 26 +++++++++++++++++++++++---
 src/types.ts             |  8 +++++++-
 stdlib/effect.ts         |  3 +++
 5 files changed, 72 insertions(+), 7 deletions(-)

diff --git a/examples/file.ts b/examples/file.ts
index 5af04da..fb38613 100644
--- a/examples/file.ts
+++ b/examples/file.ts
@@ -1,4 +1,4 @@
-import { Bind, Kind1 } from '../stdlib/effect'
+import { Bind, BindTo, Do, Kind1, Label } from '../stdlib/effect'
 import { PutStringLn } from '../stdlib/stdio'
 import { ReadFile } from '../stdlib/fs'
 import { Try } from '../stdlib/exception'
@@ -8,8 +8,21 @@ interface PrintK extends Kind1<string> {
 }
 
 export type main = [
-  Bind<ReadFile<'./default.nix'>, <contents extends string>() =>
-    PutStringLn<contents>>,
+  Do<[
+    BindTo<"contents", ReadFile<'./bin.js'>>,
+    PutStringLn<"------">,
+    Bind<Label<"contents">, <c extends string>() => PutStringLn<c>>,
+  ]>,
+
+  Try<Bind<Label<"contents">, PrintK>, <e extends string>() =>
+    PutStringLn<`ERROR: ${e}`>>,
+
+  PutStringLn<"-------------">,
+
+  Bind<ReadFile<'./default.nix'>, <c extends string>() =>
+    PutStringLn<c>>,
+
+  PutStringLn<"-------------">,
 
   Try<
     Bind<ReadFile<'./unicorn'>, PrintK>,
diff --git a/src/context.ts b/src/context.ts
index 06fe041..adc0be5 100644
--- a/src/context.ts
+++ b/src/context.ts
@@ -76,6 +76,8 @@ export const createContext = (options: CtxOptions): Ctx => {
   let currentEnv = 'node'
   const setEnv = (e: string) => (currentEnv = e)
 
+  const environment: Array<Map<string, string>> = []
+
   const ctx: Ctx = {
     sourceFile,
     typeChecker,
@@ -112,6 +114,27 @@ export const createContext = (options: CtxOptions): Ctx => {
     hasCustomEffect: (name) => customEffects[name] !== undefined,
 
     evaluateType,
+
+    newScope() {
+      environment.unshift(new Map)
+    },
+    addToScope(name, resKey) {
+      if (environment.length === 0) ctx.newScope()
+      const curScope = environment[0]
+      curScope?.set(name, resKey)
+    },
+    clearScope() {
+      environment.shift()
+    },
+    getKeyInScope(name) {
+      return environment.find(scope => scope.has(name))?.get(name)
+    },
+    withScope: (fn) => async () => {
+      ctx.newScope()
+      const res = await fn()
+      ctx.clearScope()
+      return res
+    },
   }
 
   return ctx
diff --git a/src/eval-env/builtins.ts b/src/eval-env/builtins.ts
index ed94943..1ded638 100644
--- a/src/eval-env/builtins.ts
+++ b/src/eval-env/builtins.ts
@@ -123,7 +123,7 @@ export default (ctx: Ctx, args: Type[]) => ({
     return [resultKey]
   },
 
-  Bind: async () => {
+  Bind: ctx.withScope(async () => {
     const [inputTyp, chainToKind] = args
     const [resultKey] = inputTyp ? await ctx.evaluateType(ctx, inputTyp) : []
 
@@ -132,6 +132,26 @@ export default (ctx: Ctx, args: Type[]) => ({
     const resultType =
       applyFunc(ctx, chainToKind, `(${ctx.getResultExpr(resultKey)})['output']`)
     return ctx.evaluateType(ctx, resultType)
+  }),
+
+  BindTo: async () => {
+    const [labelTyp, effTyp] = args
+    const label = ctx.getTypeValue(labelTyp)
+    const [resultKey] = effTyp ? await ctx.evaluateType(ctx, effTyp) : []
+    if (resultKey) {
+      ctx.addToScope(label, resultKey)
+      return [resultKey]
+    }
+    return []
+  },
+
+  Label: async () => {
+    const label = ctx.getTypeValue(args[0])
+    const value = ctx.getKeyInScope(label)
+    if (!value) {
+      throw new Error(`Label "${label}" not found`)
+    }
+    return [value]
   },
 
   Try: async () => {
@@ -171,7 +191,7 @@ export default (ctx: Ctx, args: Type[]) => ({
     return [resultKey]
   },
 
-  Do: async () => {
+  Do: ctx.withScope(async () => {
     const [effectTyps] = args
     const effectResults = await evalList(
       ctx,
@@ -183,5 +203,5 @@ export default (ctx: Ctx, args: Type[]) => ({
       `(${ctx.getResultExpr(lastResKey)})['output']`
     )
     return [resultKey]
-  },
+  }),
 })
diff --git a/src/types.ts b/src/types.ts
index c0258db..411c8ed 100644
--- a/src/types.ts
+++ b/src/types.ts
@@ -29,5 +29,11 @@ export interface Ctx {
   runCustomEffect: (name: string, args: Type[]) => Promise<string[]>
   hasCustomEffect: (name: string) => boolean
 
-  evaluateType: (ctx: Ctx, effTyp: Type) => Promise<string[]>
+  evaluateType: (ctx: Ctx, effTyp: Type) => Promise<string[]>,
+
+  withScope: (fn: () => Promise<string[]>) => (() => Promise<string[]>),
+  newScope: () => void,
+  clearScope: () => void,
+  addToScope: (name: string, resKey: string) => void,
+  getKeyInScope: (name: string) => string | undefined,
 }
diff --git a/stdlib/effect.ts b/stdlib/effect.ts
index 341a620..f3ef99e 100644
--- a/stdlib/effect.ts
+++ b/stdlib/effect.ts
@@ -13,6 +13,9 @@ export type Func<Inp = unknown, Out = unknown>
 
 export interface Bind<_Eff extends Effect, _Fn extends Func> extends Effect {}
 
+export interface BindTo<_Name extends string, _Eff extends Effect> extends Effect {}
+export interface Label<_Name extends string> extends Effect {}
+
 export interface Seq<_Effs extends Effect[]> extends Effect {}
 
 export interface Do<_Effs extends Effect[]> extends Effect {}
-- 
cgit v1.3.1