From a666cd027fe601d99942e8da39e3ba1cf45e5668 Mon Sep 17 00:00:00 2001 From: sslinky <39886505+SSlinky@users.noreply.github.com> Date: Fri, 13 Jun 2025 08:43:47 +0800 Subject: [PATCH 1/5] Added case insensitive string compare --- server/src/extensions/stringExtensions.ts | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/server/src/extensions/stringExtensions.ts b/server/src/extensions/stringExtensions.ts index 7f48100..289347f 100644 --- a/server/src/extensions/stringExtensions.ts +++ b/server/src/extensions/stringExtensions.ts @@ -6,6 +6,7 @@ declare global { stripQuotes(): string; toFilePath(): string; toFileUri(): string; + ciEquals(s: string): boolean; } } @@ -25,3 +26,9 @@ String.prototype.toFileUri = function (): string { ? pathToFileURL(this.toString()).href : this.toString(); }; + +String.prototype.ciEquals = function (s: string): boolean { + return this.localeCompare(s, undefined, { + sensitivity: 'accent' + }) === 0; +}; \ No newline at end of file From 886f17b231387cfd08f28f974aa4e3966379cdfa Mon Sep 17 00:00:00 2001 From: sslinky <39886505+SSlinky@users.noreply.github.com> Date: Fri, 13 Jun 2025 08:44:18 +0800 Subject: [PATCH 2/5] Removed auto build as it was mucking with break points --- .vscode/launch.json | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/.vscode/launch.json b/.vscode/launch.json index 02afd39..d7ebf12 100644 --- a/.vscode/launch.json +++ b/.vscode/launch.json @@ -10,11 +10,7 @@ "args": [ "--extensionDevelopmentPath=${workspaceRoot}", "${workspaceFolder}/sample/project" - ], - "preLaunchTask": { - "type": "npm", - "script": "build" - } + ] }, { "type": "node", From 952991c0d941e74bc5dabe3e19eca889685862d2 Mon Sep 17 00:00:00 2001 From: sslinky <39886505+SSlinky@users.noreply.github.com> Date: Fri, 13 Jun 2025 08:46:54 +0800 Subject: [PATCH 3/5] Switched lower for upper case due to CA1308 --- server/src/extensions/antlrVbaPreParserExtensions.ts | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/server/src/extensions/antlrVbaPreParserExtensions.ts b/server/src/extensions/antlrVbaPreParserExtensions.ts index aa2b513..d52f26b 100644 --- a/server/src/extensions/antlrVbaPreParserExtensions.ts +++ b/server/src/extensions/antlrVbaPreParserExtensions.ts @@ -17,9 +17,9 @@ CompilerConditionalStatementContext.prototype.vbaExpression = function (): strin return (this.compilerIfStatement() ?? this.compilerElseIfStatement())! .booleanExpression() .getText() - .toLowerCase(); + .toUpperCase(); }; DirectiveExpressionContext.prototype.vbaExpression = function (): string { - return this.getText().toLowerCase(); + return this.getText().toUpperCase(); }; \ No newline at end of file From 6c60ee465cb442609982efc57ed09b14fdc66c22 Mon Sep 17 00:00:00 2001 From: sslinky <39886505+SSlinky@users.noreply.github.com> Date: Fri, 13 Jun 2025 08:47:43 +0800 Subject: [PATCH 4/5] Switched to proper AST evaluation rather than transpile to TS --- server/src/antlr/vbapre.g4 | 5 +- server/src/capabilities/diagnostics.ts | 8 + server/src/project/elements/precompiled.ts | 261 +++++++++++++++++++-- 3 files changed, 250 insertions(+), 24 deletions(-) diff --git a/server/src/antlr/vbapre.g4 b/server/src/antlr/vbapre.g4 index 60e92a3..face58f 100644 --- a/server/src/antlr/vbapre.g4 +++ b/server/src/antlr/vbapre.g4 @@ -60,7 +60,8 @@ orderOfOps2: MOD; orderOfOps3: PLUS | SUBT; orderOfOps4: AMP; orderOfOps5: LIKE | (LT | GT)? (LT | GT | EQ) | EQ; -orderOfOps6: AND | OR | XOR | EQV | IMP; +orderOfOps6: anyWord; +// orderOfOps6: AND | OR | XOR | EQV | IMP; directiveExpression @@ -153,7 +154,6 @@ reservedWord | PLUS | SUBT | THEN - | compilerConstant ; unreservedWord @@ -166,6 +166,7 @@ unreservedWord | NOTHING | NULL_ | TRUE + | compilerConstant ; anyWord: ( unreservedWord | reservedWord)+; diff --git a/server/src/capabilities/diagnostics.ts b/server/src/capabilities/diagnostics.ts index 309a70c..50ff80d 100644 --- a/server/src/capabilities/diagnostics.ts +++ b/server/src/capabilities/diagnostics.ts @@ -96,6 +96,14 @@ export class AmbiguousNameDiagnostic extends BaseDiagnostic { } } +// test +export class CannotEvaluateExpressionDiagnostic extends BaseDiagnostic { + severity = DiagnosticSeverity.Error; + constructor(range: Range, message: string) { + super(range); + this.message = `Cannot evaluate expression: '${message}'.`; + } +} // test export class ShadowDeclarationDiagnostic extends BaseDiagnostic { diff --git a/server/src/project/elements/precompiled.ts b/server/src/project/elements/precompiled.ts index 1a7e3e0..18fa373 100644 --- a/server/src/project/elements/precompiled.ts +++ b/server/src/project/elements/precompiled.ts @@ -2,20 +2,23 @@ import { TextDocument } from 'vscode-languageserver-textdocument'; // Antlr -import { CompilerConditionalBlockContext, CompilerDefaultBlockContext, CompilerIfBlockContext, ConstDirectiveStatementContext } from '../../antlr/out/vbapreParser'; +import { CompilerConditionalBlockContext, CompilerDefaultBlockContext, CompilerIfBlockContext, ConstDirectiveStatementContext, DirectiveExpressionContext, DirectiveLiteralExpressionContext, OrderOfOps1Context, OrderOfOps2Context, OrderOfOps3Context, OrderOfOps4Context, OrderOfOps5Context, OrderOfOps6Context } from '../../antlr/out/vbapreParser'; // Project import { DiagnosticCapability, FoldingRangeCapability, IdentifierCapability } from '../../capabilities/capabilities'; import { BaseRuleSyntaxElement } from '../elements/base'; -import { UnreachableCodeDiagnostic } from '../../capabilities/diagnostics'; +import { CannotEvaluateExpressionDiagnostic, UnreachableCodeDiagnostic } from '../../capabilities/diagnostics'; +import { Services } from '../../injection/services'; type DocumentSettings = { environment: { os: string, version: string } }; export class CompilerDirectiveElement extends BaseRuleSyntaxElement { identifierCapability: IdentifierCapability; + diagnosticCapability: DiagnosticCapability; - constructor(ctx: ConstDirectiveStatementContext, + constructor( + ctx: ConstDirectiveStatementContext, doc: TextDocument, private readonly documentSettings: DocumentSettings, private readonly directiveConstants: Map) { @@ -23,18 +26,34 @@ export class CompilerDirectiveElement extends BaseRuleSyntaxElement ctx.constDirectiveName(); this.identifierCapability = new IdentifierCapability(this, getNameCtx); + this.diagnosticCapability = new DiagnosticCapability(this); } - evaluate(): string { - const vbaExpression = this.context.rule.directiveExpression().vbaExpression(); - try { - const tsExpression = transpileVbaToTypescript(vbaExpression, this.documentSettings, this.directiveConstants); - const getExpressionResult = Function('"use strict"; return (' + tsExpression + ')'); - return getExpressionResult().toString(); - } catch (e) { - // FIXME Add a diagnostic for if this fails. - return '0'; + evaluate(): string | number | boolean | Date | null { + const expr = new Expression(this.context.rule.directiveExpression(), this.context.document, this.documentSettings, this.directiveConstants); + const result = expr.evaluate(); + + Services.logger.log(`Evaluated ${expr.context.text} to ${result}`); + + if (result === undefined) { + const diagnostic = new CannotEvaluateExpressionDiagnostic(expr.context.range, expr.context.text); + this.diagnosticCapability.diagnostics.push(diagnostic); + return null; } + + return result; + + // const vbaExpression = this.context.rule.directiveExpression().vbaExpression(); + // try { + // const tsExpression = transpileVbaToTypescript(vbaExpression, this.documentSettings, this.directiveConstants); + // const getExpressionResult = Function('"use strict"; return (' + tsExpression + ')'); + // return getExpressionResult().toString(); + // } catch (e) { + // const expressionRange = this.context.rule.directiveExpression().toRange(this.context.document); + // const diagnostic = new CannotEvaluateExpressionDiagnostic(expressionRange, vbaExpression); + // this.diagnosticCapability.diagnostics.push(diagnostic); + // return '0'; + // } } } @@ -97,11 +116,11 @@ class CompilerConditionBlock extends BaseRuleSyntaxElement ${tsExpression}.`); } return result; } @@ -115,25 +134,222 @@ class CompilerConditionBlock extends BaseRuleSyntaxElement { + private leftExpr?: Expression; + private rightExpr?: Expression; + private operatorCtx?: OperatorContext; + private isNot = false; + + constructor( + ctx: DirectiveExpressionContext, + doc: TextDocument, + private readonly documentSettings: DocumentSettings, + private readonly directiveConstants: Map + ) { + super(ctx, doc); + + // Set the left, right, and operator if we have them. + const expressions = ctx.directiveExpression().map(x => + new Expression(x, doc, documentSettings, directiveConstants) + ); + this.leftExpr = expressions[0]; + this.rightExpr = expressions[1]; + this.operatorCtx = ctx.orderOfOps1() + ?? ctx.orderOfOps2() + ?? ctx.orderOfOps3() + ?? ctx.orderOfOps4() + ?? ctx.orderOfOps5() + ?? ctx.orderOfOps6() + ?? undefined; + + // If we're a 'not' expression, set the flag and the left side only. + const notCtx = ctx.notDirectiveExpression(); + if (notCtx) { + this.isNot = true; + const leftExprCtx = notCtx.directiveExpression(); + this.leftExpr = new Expression(leftExprCtx, doc, documentSettings, directiveConstants); + } + + // Set the expression from the parenthesized expression if we have one. + const parenthExpr = ctx.directiveParenthesizedExpression()?.directiveExpression(); + if (parenthExpr) { + this.leftExpr = new Expression(parenthExpr, doc, documentSettings, directiveConstants); + } + } + + evaluate(): string | number | boolean | Date | null | undefined { + // Evaluate a not expression. + if (this.isNot && this.leftExpr) { + return !this.leftExpr.evaluate(); + } + + // Evaluate as left-operator-right. + if (this.leftExpr && this.rightExpr && this.operatorCtx) { + const result = this.performCalculation(this.leftExpr, this.rightExpr, this.operatorCtx); + return result; + } + + // Evaluate a literal if we have one. + const ctx = this.context.rule; + const literal = ctx.directiveLiteralExpression(); + if (literal) { + return this.evaluateValue(literal); + } + + // Evaluate an environment constant if we have one. + const envConstant = ctx.unreservedWord() + ?.compilerConstant() + ?.getText(); + if (envConstant) { + return envConstant.ciEquals(this.documentSettings.environment.os) + || envConstant.ciEquals(this.documentSettings.environment.version); + } + + // Evaluate a user constant if we have one. + const userConstant = ctx.unreservedWord()?.getText(); + if (userConstant) { + return this.directiveConstants.get(userConstant); + } + + // Otherwise try to return the left expression. + return this.leftExpr?.evaluate(); + } + + private evaluateValue(literal: DirectiveLiteralExpressionContext) { + // Handle a boolean literal. + const boolCtx = literal.literalIdentifier()?.booleanLiteralIdentifier(); + if (boolCtx) return !!boolCtx.TRUE(); + + // Handle a string literal. + const stringCtx = literal.LITSTRING(); + if (stringCtx) return stringCtx.getText(); + + // Handle a whole number literal. + const intCtx = literal.LITINTEGER(); + if (intCtx) return Number.parseInt(intCtx.getText()); + + // Handle a floating point number literal. + const floatCtx = literal.LITFLOAT(); + if (floatCtx) return Number.parseFloat(floatCtx.getText()); + + // Handle a date literal. + const dateCtx = literal.LITDATE(); + if (dateCtx) { + const dateStr = RegExp('#([^#]*)#').exec(dateCtx.getText())?.[1]; + return dateStr ? new Date(dateStr) : undefined; + } + + // If we get here, we are Null, Empty, or Nothing. + return null; + } + + private performCalculation(left: Expression, right: Expression, operation: OperatorContext): number | boolean | string | Date | null | undefined { + const lResult = left.evaluate(); + const rResult = right.evaluate(); + + // Pass on undefined if one or both of our values evaluated to undefined. + if (lResult === undefined || rResult === undefined) return undefined; + + // TODO: Test scenarios to account for differences in the way each language coerces values. + const ops = new Map number | boolean | string | Date | null>(); + ops.set('+', (x, y) => x + y); + ops.set('-', (x, y) => x - y); + ops.set('*', (x, y) => x * y); + ops.set('/', (x, y) => x / y); + ops.set('\\', (x, y) => Math.floor(x / y)); + ops.set('=', (x, y) => x == y); + ops.set('MOD', (x, y) => x % y); + ops.set('OR', (x, y) => x || y); + ops.set('XOR', (x, y) => x ^ y); + ops.set('AND', (x, y) => x && y); + ops.set('<', (x, y) => x < y); + ops.set('>', (x, y) => x > y); + ops.set('>=', (x, y) => x >= y); + ops.set('<=', (x, y) => x <= y); + ops.set('<>', (x, y) => x != y); + ops.set('&', (x, y) => { + const concat = `${x}${y}`; + if (concat.length > 0 && /^\s*-?(\d+|\d*\.\d+)\s*$/.test(concat)) { + return parseFloat(concat); + } else { + return concat; + } + }); + + // Like is not a valid operator in constant expressions, + // however, the code may eventually be useful elsewhere. + // ops.set('like', (x, y) => { + // const a = x.toString(); + // const b = y.toString(); + + // if (a === b) { + // return true; + // } + + // const pattern = b.replace(/[#?*]/g, (tag: string): string => + // (new Map([ + // ['#', '\\d'], + // ['?', '.'], + // ['*', '.*'], + // ])).get(tag) ?? tag); + + // return RegExp(pattern).test(a); + // }); + + ops.set('EQV', (x: any, y: any) => { + const xnor = ~(x ^ y); + const bits = (x > y ? x : y).toString(2).length; + const mask = (1 << bits) - 1; + return xnor & mask; + }); + + // There's no way this works the same as in VBA. + // Probably need to infer the bits from the variable type. + ops.set('IMP', (x: any, y: any) => { + const imp = ~x | y; + const bits = (x > y ? x : y).toString(2).length; + const mask = (1 << bits) - 1; + return imp & mask; + }); + + // Perform the operation if it's a known type. + const op = ops.get(operation.getText().toUpperCase()); + if (op) return op(lResult, rResult); + } +} + + function transpileVbaToTypescript(exp: string, settings: DocumentSettings, directives: Map): string { // Convert the environment constant to boolean. - const envToBooleanText = (opt: string) => { - const isOs = settings.environment.os.toLowerCase() == opt; - const isVer = settings.environment.version.toLowerCase() == opt; - return isOs || isVer ? 'true' : 'false'; - }; + const envToBooleanText = (opt: string): string => ( + opt.ciEquals(settings.environment.os) + || opt.ciEquals(settings.environment.version) + ).toString(); // Set up text replacements map. const constants = ['vba6', 'vba7', 'mac', 'win16', 'win32', 'win64']; const replacements = new Map(constants.map(x => [x, envToBooleanText(x)])); + replacements.set('<>', '!='); replacements.set('or', '||'); + replacements.set('xor', '^'); + replacements.set('mod', '%'); + replacements.set('not', '!'); replacements.set('and', '&&'); - replacements.set('not ', '!'); + replacements.set('eqv', ''); + + const getPattern = (x: string) => `(.*)\\b${x}\\b(.*)`; // Perform language text replacements. let result = exp; replacements.forEach((v, k) => { - const regexp = RegExp(`\\b${k}\\b`, 'i'); + const regexp = RegExp(getPattern(k), 'i'); if (regexp.test(result)) { result = result.replace(regexp, v); } @@ -141,8 +357,9 @@ function transpileVbaToTypescript(exp: string, settings: DocumentSettings, direc // Perform user directives text replacements. directives.forEach((v, k) => { - const regexp = RegExp(`\\b${k}\\b`, 'i'); + const regexp = RegExp(getPattern(k), 'i'); if (regexp.test(result)) { + Services.logger.log(`Replacing ${k} with ${v}`); result = result.replace(regexp, v); } }); From 99b43eaa973ad637fd90f1e28db54e7a3b8c7254 Mon Sep 17 00:00:00 2001 From: sslinky <39886505+SSlinky@users.noreply.github.com> Date: Fri, 13 Jun 2025 08:49:13 +0800 Subject: [PATCH 5/5] 1.7.3 --- package-lock.json | 4 ++-- package.json | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/package-lock.json b/package-lock.json index 508dbf4..87c168f 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,12 +1,12 @@ { "name": "vba-lsp", - "version": "1.7.2", + "version": "1.7.3", "lockfileVersion": 3, "requires": true, "packages": { "": { "name": "vba-lsp", - "version": "1.7.2", + "version": "1.7.3", "hasInstallScript": true, "license": "MIT", "dependencies": { diff --git a/package.json b/package.json index 48dcc2a..495ed45 100644 --- a/package.json +++ b/package.json @@ -6,7 +6,7 @@ "icon": "images/vba-lsp-icon.png", "author": "SSlinky", "license": "MIT", - "version": "1.7.2", + "version": "1.7.3", "repository": { "type": "git", "url": "https://github.com/SSlinky/VBA-LanguageServer"