Merge pull request #208 from rolyp/move-annotations

Move usage annotations from values to traces

karma.conf.js

@@ -18,14 +18,13 @@ module.exports = function (config) {
             served: true,
             nocache: false
          }
-
       ],
       exclude: [
          // otherwise these will also appear as entry points
          './test/util/*',
       ],
       preprocessors: {
-         './bundle.js': ['webpack'],
+         './src/**/*.ts': ['webpack'],
          'test/**/*.ts': ['webpack']
       },
       webpack: {

package.json

@@ -13,7 +13,7 @@
     "three-orbitcontrols-ts": "^0.1.2",
     "three.meshline": "^1.2.0",
     "ts-loader": "^4.0.0",
-    "typescript": "^3.4.5"
+    "typescript": "^3.6.3"
   },
   "devDependencies": {
     "@types/chai": "^3.4.35",

src/Annotated.ts

@@ -1,6 +1,6 @@
-import { Class, absurd, className } from "./util/Core"
+import { Class, __nonNull } from "./util/Core"
 import { Annotation, ann } from "./util/Lattice"
-import { Id, Num, Persistent, Str, Value, ValueTag, _ } from "./Value"
+import { MemoFunType, Num, Persistent, Str, Value, ValueTag, _, __delta, memo } from "./Value"
 import { ν, at } from "./Versioned"
 
 // For trait idiom see https://www.bryntum.com/blog/the-mixin-pattern-in-typescript-all-you-need-to-know/ and
@@ -14,75 +14,68 @@ export function AnnotatedC<T extends Class<Value>> (C: T) {
    }[C.name] // give versioned class same name as C
 }
 
-// Not sure how to avoid duplicating the body with those of the classes returned by AnnotatedC.
-export interface Annotated_ {
+export interface Annotated {
    __α: Annotation
 }
 
-export type Annotated<T> = Annotated_ & T
-
-export function annotated<T extends Object> (v: T): v is Annotated<T> {
+export function annotated<T extends Object> (v: T): v is T & Annotated {
    return v.hasOwnProperty("__α")
 }
 
-export function asAnnotated<T> (v: T): Annotated<T> {
-   if (annotated(v)) {
-      return v
-   } else {
-      return absurd(`Not an annotated value: ${className(v)}`)
+export function setα<T extends Annotated & Value> (α: Annotation, v: T): T {
+   if (v.__α !== α) {
+      __delta.add([v, "__α", α])
    }
-}
-
-export function setα<T, U extends Annotated<T>> (α: Annotation, v: U): U {
    v.__α = α
    return v
 }
 
-export function setallα<Tag extends ValueTag, T extends Value<Tag>> (α: Annotation, v: T): T {
+// Memoising an imperative function makes any side effects idempotent. Not clear yet how to "partially" 
+// memoise LVar-like functions like joinα, but setall isn't one of those.
+export function setallα<T extends Persistent> (α: Annotation, v: T): T {	
+   return memo<T>(setallα_ as MemoFunType<T>, α, v)
+}	
+
+export function setallα_<Tag extends ValueTag, T extends Value<Tag>> (α: Annotation, v: T): T {
    if (annotated(v)) {
       setα(α, v)
    }
-   v.fieldValues().forEach((v: Persistent): void => {
+   v.children().forEach((v: Persistent): void => {
       if (v instanceof Value) {
          setallα(α, v)
       }
    })
    return v
 }
 
-export function negateallα<Tag extends ValueTag, T extends Value<Tag>> (v: T): T {
+export function negateallα<T extends Persistent> (v: T): T {	
+   return memo<T>(negateallα_ as MemoFunType<T>, v)
+}	
+
+export function negateallα_<Tag extends ValueTag, T extends Value<Tag>> (v: T): T {
    if (annotated(v)) {
       setα(ann.negate(v.__α), v)
    }
-   v.fieldValues().forEach((v: Persistent): void => {
+   v.children().forEach((v: Persistent): void => {
       if (v instanceof Value) {
          negateallα(v)
       }
    })
    return v
 }
 
-export function joinα<T, U extends Annotated<T>> (α: Annotation, v: U): U {
-   v.__α = ann.join(α, v.__α)
-   return v
-}
-
-export function meetα<T, U extends Annotated<T>> (α: Annotation, v: U): U {
-   v.__α = ann.meet(α, v.__α)
-   return v
+export function setjoinα<T extends Annotated & Value> (α: Annotation, v: T): T {
+   return setα(ann.join(α, v.__α), v)
 }
 
-// Make an annotated node, for a class that doesn't already specify statically that its instances are annotated.
-export function annotatedAt<T extends Value> (k: Id, C: Class<T>, ...v̅: Persistent[]): Annotated<T> {
-   const v: T = at(k, C, ...v̅);
-   (v as any).__α = _
-   return v as Annotated<T>
+export function setmeetα<T extends Annotated & Value> (α: Annotation, v: T): T {
+   return setα(ann.meet(α, v.__α), v)
 }
 
-export function num (val: number): Annotated<Num> {
-   return annotatedAt(ν(), Num, val)
+export function num (val: number): Num {
+   return at(ν(), Num, val)
 }
 
-export function str (val: string): Annotated<Str> {
-   return annotatedAt(ν(), Str, val)
+export function str (val: string): Str {
+   return at(ν(), Str, val)
 }

src/BaseTypes.ts

@@ -1,9 +1,8 @@
 import { absurd } from "./util/Core"
-import { Annotated, annotatedAt } from "./Annotated"
 import { initDataType } from "./DataType"
 import { DataValue } from "./DataValue"
+import { dataValue } from "./Eval"
 import { Persistent, _, make } from "./Value"
-import { ν } from "./Versioned"
 
 // See Env for convention regarding instance members on reflected datatypes.
 
@@ -13,15 +12,15 @@ export abstract class Bool extends DataValue<"Bool"> {
 export class True extends Bool {
 }
 
-export function true_ (): Annotated<Bool> {
-   return annotatedAt(ν(), True)
+export function true_ (): Bool {
+   return dataValue(True.name, []) as Bool
 }
 
 export class False extends Bool {
 }
 
-export function false_ (): Annotated<Bool> {
-   return annotatedAt(ν(), False)
+export function false_ (): Bool {
+   return dataValue(False.name, []) as Bool
 }
 
 export abstract class List<T> extends DataValue<"List"> {

src/DataType.ts

@@ -1,6 +1,7 @@
 import { AClass, Class, __nonNull, assert } from "./util/Core"
 import { str } from "./Annotated"
-import { DataExpl, DataValue } from "./DataValue"
+import { DataValue } from "./DataValue"
+import { Expl } from "./Expl"
 import { DataElim } from "./Match"
 import { Num, PrimValue, Str, _, fields } from "./Value"
 
@@ -18,14 +19,14 @@ export class PrimType {
 export class DataType {
    name: Str
    elimC: Class<DataElim>            
-   ctrs: Map<string, Ctr>                 // fields of my constructors
-   explC̅: Map<string, Class<DataExpl>>    // "explanation" class per constructor
+   ctrs: Map<string, Ctr>                    // fields of my constructors
+   explC̅: Map<string, Class<Expl.DataExpl>>  // "explanation" class per constructor
 
    constructor (
       name: Str,
       elimC: Class<DataElim>, 
       ctrs: Map<string, Ctr>, 
-      explC̅: Map<string, Class<DataExpl>>
+      explC̅: Map<string, Class<Expl.DataExpl>>
    ) {
       this.name = name
       this.elimC = elimC
@@ -81,9 +82,9 @@ export function initDataType<T extends DataValue> (D: AClass<T>, C̅: Class<T>[]
             }
          }[elimC_name],
          explC_name: string = D.name + explSuffix,
-         explC̅: [string, Class<DataExpl>][] = ctrs.map(([cʹ, c]: [string, Ctr]) => {
+         explC̅: [string, Class<Expl.DataExpl>][] = ctrs.map(([cʹ, c]: [string, Ctr]) => {
             return [cʹ, {
-               [explC_name]: class extends DataExpl {
+               [explC_name]: class extends Expl.DataExpl {
                   constructor () {
                      super()
                      c.f̅.forEach((f: string): void => {

src/DataValue.ts

@@ -1,23 +1,24 @@
-import { zip } from "./util/Array"
-import { Annotated } from "./Annotated"
-import { Expl } from "./ExplValue"
-import { DataValueTag, State, Value, fields } from "./Value"
+import { __nonNull } from "./util/Core"
+import { Expl } from "./Expl"
+import { DataValueTag, Value, _, make } from "./Value"
 
-// Value of a datatype constructor; fields are always user-level values (i.e. not ES6 primitives).
+// Value of a datatype constructor; children are always user-level values (i.e. not ES6 primitives).
 export class DataValue<Tag extends DataValueTag = DataValueTag> extends Value<Tag> {
-   __expl: DataExpl
-
-   fieldValues (): Value[] {
-      return fields(this).map(k => (this as any as State)[k] as Value)
+   child (k: string): Value {
+      return super.child(k) as Value
    }
 
-   fieldExplValues(): [Expl, Annotated<Value>][] {
-      return zip(this.__expl.fieldValues(), this.fieldValues() as Annotated<Value>[])
+   children (): Value[] {
+      return super.children() as Value[]
    }
 }
 
-export class DataExpl extends DataValue<"DataExpl"> {
-   fieldValues (): Expl[] {
-      return fields(this).map(k => (this as any as State)[k] as Expl)
-   }
+// Here to break cyclic dependency.
+export class ExplValue<T extends Value = Value> extends DataValue<"ExplValue"> {
+   t: Expl = _
+   v: T = _
+}
+
+export function explValue<T extends Value = Value> (t: Expl, v: T): ExplValue<T> {
+   return make(ExplValue, t, v) as ExplValue<T>
 }

src/Env.ts

@@ -1,19 +1,18 @@
 import { absurd } from "./util/Core"
-import { Annotated } from "./Annotated"
-import { DataValue } from "./DataValue"
-import { Str, Value, _, make } from "./Value"
+import { DataValue, ExplValue } from "./DataValue"
+import { Str, _, make } from "./Value"
 
 // Idiom is to permit instance methods on reflected datatypes, but not have them use polymorphism.
 
 // Environments are snoc lists.
 export abstract class Env extends DataValue<"Env"> {
-   get (k: Annotated<Str>): Annotated<Value> | undefined {
+   get (k: Str): ExplValue | undefined {
       if (this instanceof EmptyEnv) {
          return undefined
       } else
       if (this instanceof ExtendEnv) {
          if (this.k.val === k.val) {
-            return this.v
+            return this.tv
          } else {
             return this.ρ.get(k)
          }
@@ -22,20 +21,20 @@ export abstract class Env extends DataValue<"Env"> {
       }
    }
 
-   has (k: Annotated<Str>): boolean {
+   has (k: Str): boolean {
       return this.get(k) !== undefined
    }
 
-   static singleton (k: Annotated<Str>, v: Annotated<Value>): ExtendEnv {
-      return extendEnv(emptyEnv(), k, v)
+   static singleton (k: Str, tv: ExplValue): ExtendEnv {
+      return extendEnv(emptyEnv(), k, tv)
    }
 
    concat (ρ: Env): Env {
       if (ρ instanceof EmptyEnv) {
          return this
       } else
       if (ρ instanceof ExtendEnv) {
-         return extendEnv(this.concat(ρ.ρ), ρ.k, ρ.v)
+         return extendEnv(this.concat(ρ.ρ), ρ.k, ρ.tv)
       } else {
          return absurd()
       }
@@ -51,10 +50,10 @@ export function emptyEnv (): EmptyEnv {
 
 export class ExtendEnv extends Env {
    ρ: Env = _
-   k: Annotated<Str> = _
-   v: Annotated<Value> = _
+   k: Str = _
+   tv: ExplValue = _
 }
 
-export function extendEnv (ρ: Env, k: Annotated<Str>, v: Annotated<Value>): ExtendEnv {
-   return make(ExtendEnv, ρ, k, v)
+export function extendEnv (ρ: Env, k: Str, tv: ExplValue): ExtendEnv {
+   return make(ExtendEnv, ρ, k, tv)
 }