vm.bqn


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159

MakeVar ← {𝕤
  v←@
  Get  ⇐ !∘"Runtime: Variable referenced before definition"
  SetU ⇐ !∘"↩: Variable modified before definition"
  SetN ⇐ {
    Get ↩ {𝕤⋄v}
    (SetU ↩ {v↩𝕩}) 𝕩
  }
  SetQ ⇐ 0∘SetN
  GetC ⇐ {
    r ← Get𝕩
    Get↩SetU↩SetN↩!∘"Internal error: Variable used after clear"
    r
  }
}
MakeEnv ← {
  vars ⇐ MakeVar¨ ↕𝕨
  parent ⇐ 𝕩
  program ⇐ 𝕩.program
}

VO ← { d←𝕏@, s←𝕏@, s⊑·{𝕩.vars}{𝕩.parent}⍟d }

nothing  ← {⇐}
skipMark ← {⇐}

Namespace ← !
ReadNS ← !

ref ← {
  Matcher ⇐ {𝕊 const:
    SetQ ⇐ const˙ ≢ ⊢
  }
  Array ⇐ {𝕊 arr:
    Get  ⇐ {𝕩.Get@}¨ arr˙
    _set ← {arr ≡○≢◶⟨!, 𝕗¨⟩ ⊢}
    SetN ⇐ {𝕨.SetN𝕩}_set
    SetU ⇐ {𝕨.SetU𝕩}_set
    SetQ ⇐ arr ≡○≢◶⟨1, ∨´{𝕨.SetQ𝕩}¨⟩ ⊢
  }
}

Get ← {𝕩.Get @}⚇0

MakeStack ← {
  s ← 𝕩                          # Stack (a list)
  cont ⇐ 1                       # Whether to continue execution
  rslt ⇐ skipMark                # Result: skipMark to abort current body
  Push ⇐ {s∾↩<𝕩}                 # Push a value
  Pop  ⇐ {t←-𝕩 ⋄ (s↓˜↩t) ⊢ ⌽t↑s} # Pop 𝕩 values; return as list
  Peek ⇐ {𝕤⋄¯1⊑s}                # Return but don't pop top value
  Ret  ⇐ {rslt↩𝕩 ⋄ cont↩0 ⋄ "Internal compiler error: Wrong stack size"!0=≠s}
  Skip ⇐ {𝕤⋄       cont↩0}
}

ops ← ((!∘"Unknown opcode")˙⊣´⊢)¨ ⊔˝ ⍉> ⟨
  # Constants and drop
   0‿{i←𝕏@ ⋄ {s𝕊e: s.Push         i⊑e.program.consts } }
   1‿{i←𝕏@ ⋄ {s𝕊e: s.Push e {𝕎𝕩}˜ i⊑e.program.blocks } }
   6‿(       {s𝕊e: s.Pop 1 }˙)
  # Returns
   7‿(       {s𝕊e: 0 s.Ret ⊑s.Pop 1 }˙)
   8‿(       {s𝕊e: 1 s.Ret Namespace e }˙)
  # Arrays
  11‿{i←𝕏@ ⋄ {s𝕊e: s.Push           ⌽s.Pop i } }
  12‿{i←𝕏@ ⋄ {s𝕊e: s.Push ref.Array ⌽s.Pop i } }
  # Application
  16‿(       {s𝕊e: s.Push {   f‿x:   F x }   s.Pop 2 }˙)
  17‿(       {s𝕊e: s.Push { w‿f‿x: w F x }   s.Pop 3 }˙)
  20‿(       {s𝕊e: s.Push {   g‿h:   G H }   s.Pop 2 }˙)
  21‿(       {s𝕊e: s.Push { f‿g‿h: F G H }   s.Pop 3 }˙)
  26‿(       {s𝕊e: s.Push { f‿m  : F _m    } s.Pop 2 }˙)
  27‿(       {s𝕊e: s.Push { f‿m‿g: F _m_ g } s.Pop 3 }˙)
  # Application with Nothing
  18‿(       {s𝕊e: s.Push {   f‿x:                    F⍟(nothing⊸≢) x } s.Pop 2 }˙) # Like 16
  19‿(       {s𝕊e: s.Push { w‿f‿x: (nothing≢w˙)◶⟨F,w⊸F⟩⍟(nothing⊸≢) x } s.Pop 3 }˙) # Like 17
  23‿(       {s𝕊e: s.Push { f‿g‿h: {f≡nothing?G H;F G H}              } s.Pop 3 }˙) # Like 21
  22‿(       {s𝕊e: "Left argument required" ! nothing≢s.Peek@ }˙)
  # Variables
  32‿{v←VO𝕩⋄ {s𝕊e: s.Push (V e).Get @ } }
  34‿{v←VO𝕩⋄ {s𝕊e: s.Push (V e).GetC@ } }
  33‿{v←VO𝕩⋄ {s𝕊e: s.Push  V e        } }
  # Headers
  42‿(       {s𝕊e: {0:s.Skip@; 1:@; 𝕊:!"Predicate value must be 0 or 1"} ⊑s.Pop 1 }˙)
  43‿(       {s𝕊e: s.Push ref.Matcher ⊑s.Pop 1 }˙)
  # Assignment
  47‿(       {s𝕊e: s.Skip⍟⊢{r‿  v: r.SetQ v           } s.Pop 2 }˙)  # r:
  48‿(       {s𝕊e: s.Push { r‿  v: r.SetN v           } s.Pop 2 }˙)  # r  ←v
  49‿(       {s𝕊e: s.Push { r‿  v: r.SetU v           } s.Pop 2 }˙)  # r  ↩v
  50‿(       {s𝕊e: s.Push { r‿f‿x: r.SetU (r.Get@)F x } s.Pop 3 }˙)  # r F↩x
  51‿(       {s𝕊e: s.Push { r‿f  : r.SetU F r.Get@    } s.Pop 2 }˙)  # r F↩
  # Namespaces
  64‿{i←𝕏@ ⋄ {s𝕊e: s.Push e‿i ReadNS    ⊑s.Pop 1 } }
  66‿{i←𝕏@ ⋄ {s𝕊e: s.Push e‿i ref.Alias ⊑s.Pop 1 } }
⟩

RunBC ← { bc‿pos‿env:
  Next ← {𝕤⋄ (pos+↩1) ⊢ pos⊑bc }
  stack ← MakeStack ⟨⟩
  Step ← {𝕊:
    op ← (Next@) ⊑ ops
    op ↩ Op next
    stack Op env
    stack.cont
  }
  _while_ ← {𝔽⍟𝔾∘𝔽_𝕣_𝔾∘𝔽⍟𝔾𝕩}
  Step _while_ ⊢ 1
  stack.rslt
}

{ VM bc‿consts‿blockInfo‿bodyInfo‿loc‿token:

  bodies ← {start‿vars‿names‿export:
    {parent 𝕊 args:
      env ← vars MakeEnv parent  # names/export?
      (⊢ {𝕩.SetN 𝕨}¨ ≠↑env.vars˙) args
      RunBC bc‿start‿env
    }
  }¨ bodyInfo

  blocks ← {type‿imm‿body:
    inner ← type ⊑ ⟨
      {𝕊n: N ⟨⟩}
      {𝕊n: {N 𝕣‿𝕗  }}
      {𝕊n: {N 𝕣‿𝕗‿𝕘}}
    ⟩
    outer ← imm ⊑ ⟨
      {
        m‿d: {𝕊v: {M 𝕤‿𝕩‿nothing∾v;D 𝕤‿𝕩‿𝕨∾v}} ;
        ⟨b⟩: {𝕊v: {B 𝕤‿𝕩‿(𝕨⊣nothing)∾v}}
      }
      ⊑
    ⟩

    nmc ← "No matching case"
    Then ← {first 𝕊 next: {skipMark≢r←𝕨First𝕩 ? r ; 𝕨Next𝕩}}
    run ← {
      1=•Type 𝕩 ?
      ⟨(𝕩⊑bodies) Then {!∘nmc}⟩
    ;
      "Internal compiler error: Invalid body indices" ! 1==𝕩
      ! (≠𝕩) ≡ 2-imm
      e ← {imm ? ⟨nmc⟩ ;
        (0=≠¨𝕩) nmc⍟⊣¨ "Left argument "⊸∾¨⟨"not allowed","required"⟩
      }𝕩
      𝕩 Then´⟜(⊏⟜bodies)˜⟜{!∘𝕩}¨ e
    } body
    {𝕊 parent:
      Inner Outer {parent˙ 𝕏 ⊢}¨ run
    }
  }¨ blockInfo
  
  program ← {
    consts⇐consts
    blocks⇐blocks
  }
  
  (⊑blocks){𝔽} {program⇐program}
}