diff --git a/compiler/src/IR.hs b/compiler/src/IR.hs index 2c23373..f31aa05 100644 --- a/compiler/src/IR.hs +++ b/compiler/src/IR.hs @@ -281,6 +281,7 @@ instance WellFormedIRCheck IRExpr where , "fprintlnWithLabels" , "fwrite" , "getTime" + , "getType" , "getNanoTime" , "getStdout" , "guard" diff --git a/rt/src/UserRuntime.mts b/rt/src/UserRuntime.mts index c429397..d326358 100644 --- a/rt/src/UserRuntime.mts +++ b/rt/src/UserRuntime.mts @@ -29,6 +29,7 @@ import { RuntimeAssert } from './builtins/runtimeassert.mjs' import { BuiltinService } from './builtins/service.mjs' import { BuiltinString } from './builtins/string.mjs' import { BuiltinRecordReflection } from './builtins/recordReflection.mjs' +import { BuiltinTypeInformation } from './builtins/types.mjs' let BuiltSpawnSendReceive = x => BuiltinSpawn(BuiltinSend(BuiltinReceive(x))) @@ -60,5 +61,6 @@ export const UserRuntime = BuiltinDebugUtils( BuiltinMath( BuiltinRecordReflection( - BuiltinStdIo(UserRuntimeZero) - ))))))))))))))))))))))))))) + BuiltinTypeInformation( + BuiltinStdIo(UserRuntimeZero) + )))))))))))))))))))))))))))) diff --git a/rt/src/builtins/types.mts b/rt/src/builtins/types.mts new file mode 100644 index 0000000..bc1d890 --- /dev/null +++ b/rt/src/builtins/types.mts @@ -0,0 +1,76 @@ +'use strict' +import { UserRuntimeZero, Constructor, mkBase } from './UserRuntimeZero.mjs' +import { LVal } from '../Lval.mjs'; +import { assertIsNTuple, assertIsRecord, assertIsString, assertIsUnit, assertNormalState } from '../Asserts.mjs' +import { Record } from "../Record.mjs"; +import { lub } from '../options.mjs'; +import { __unit } from '../UnitVal.mjs'; +import { TroupeType } from '../TroupeTypes.mjs'; + +export function BuiltinTypeInformation>(Base: TBase) { + return class extends Base { + // returns a string containing the type information + getType = mkBase((larg) => { + let _t = "unknown" // 2024-03-18; todo: add proper type + switch (larg.val._troupeType) { + case TroupeType.UNIT: + _t = "unit"; + break; + case TroupeType.BOOLEAN: + _t = "boolean"; + break; + case TroupeType.NUMBER: + _t = "number"; + break; + + case TroupeType.STRING: + _t = "string"; + break; + case TroupeType.PROCESS_ID: + _t = "process_id"; + break; + case TroupeType.LEVEL: + _t = "level"; + break; + case TroupeType.AUTHORITY: + _t = "authority"; + break; + case TroupeType.CLOSURE: + _t = "function"; + break; + case TroupeType.TUPLE: + _t = "tuple"; + break; + case TroupeType.LIST: + _t = "list"; + break; + case TroupeType.RECORD: + _t = "record"; + break; + case TroupeType.LOCALOBJECT: + _t = "localobject"; + break; + default: + switch (typeof larg.val) { + case 'string': + _t = "string"; + break; + case 'number': + _t = "number"; + break; + case 'boolean': + _t = "boolean" + break; + } + } + return this.runtime.ret ( + new LVal ( _t + , lub (larg.tlev, this.runtime.$t.pc) + , this.runtime.$t.pc) + ) + + + + }) + } +} diff --git a/tests/rt/pos/core/gettype.golden b/tests/rt/pos/core/gettype.golden new file mode 100644 index 0000000..4756df4 --- /dev/null +++ b/tests/rt/pos/core/gettype.golden @@ -0,0 +1,2 @@ +2024-03-18T10:10:03.645Z [RTM] info: Skipping network creation. Observe that all external IO operations will yield a runtime error. +>>> Main thread finished with value: ["string"@{}%{}, "function"@{}%{}, "number"@{}%{}, "unit"@{}%{}, "record"@{}%{}]@{}%{} diff --git a/tests/rt/pos/core/gettype.trp b/tests/rt/pos/core/gettype.trp new file mode 100644 index 0000000..db345f5 --- /dev/null +++ b/tests/rt/pos/core/gettype.trp @@ -0,0 +1,9 @@ +(* we want a simple function + getType x that returns + the information about the type +*) +import lists +let val ls = [ "hello", fn x => x + 1, 2, () , {x = 2}] +in map getType ls +end +