generated from amazon-archives/__template_Apache-2.0
-
Notifications
You must be signed in to change notification settings - Fork 28
Expand file tree
/
Copy pathStrataMain.lean
More file actions
1084 lines (1002 loc) · 45 KB
/
StrataMain.lean
File metadata and controls
1084 lines (1002 loc) · 45 KB
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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
/-
Copyright Strata Contributors
SPDX-License-Identifier: Apache-2.0 OR MIT
-/
-- Executable with utilities for working with Strata files.
import Strata.DDM.Integration.Java.Gen
import Strata.Languages.Core.Options
import Strata.Languages.Core.SarifOutput
import Strata.Languages.Laurel.Grammar.ConcreteToAbstractTreeTranslator
import Strata.Languages.Laurel.LaurelToCoreTranslator
import Strata.Languages.Python.Python
import Strata.Languages.Python.PySpecPipeline
import Strata.Languages.Python.Specs
import Strata.Languages.Python.Specs.DDM
import Strata.Languages.Python.Specs.IdentifyOverloads
import Strata.Languages.Python.Specs.ToLaurel
import Strata.Languages.Laurel.LaurelFormat
import Strata.Languages.Laurel.Laurel
import Strata.Transform.ProcedureInlining
import Strata.Languages.Python.CorePrelude
import Strata.Languages.Python.PythonRuntimeLaurelPart
import Strata.Languages.Python.PythonLaurelCorePrelude
import Strata.Backends.CBMC.CollectSymbols
import Strata.Backends.CBMC.GOTO.CoreToGOTOPipeline
import Strata.SimpleAPI
open Strata
open Core (VerifyOptions VerboseMode VerificationMode CheckLevel)
def exitFailure {α} (message : String) (hint : String := "strata --help") : IO α := do
IO.eprintln s!"Exception: {message}\n\nRun {hint} for additional help."
IO.Process.exit 1
/-- Exit with code 1 for user code errors (detected bugs in the Python source). -/
def exitUserCodeError {α} (message : String) : IO α := do
IO.eprintln s!"❌ {message}"
IO.Process.exit 1
/-- Exit with code 2 for internal errors (tool limitations or crashes). -/
def exitInternalError {α} (message : String) : IO α := do
IO.eprintln s!"Exception: {message}"
IO.Process.exit 2
def exitCmdFailure {α} (cmdName : String) (message : String) : IO α :=
exitFailure message (hint := s!"strata {cmdName} --help")
/-- How a flag consumes arguments. -/
inductive FlagArg where
| none -- boolean flag, e.g. --verbose
| arg (name : String) -- takes one value, e.g. --output <file>
| repeat (name : String) -- takes one value, may appear multiple times, e.g. --include <path>
/-- A flag that a command accepts. -/
structure Flag where
name : String -- flag name without "--", used as lookup key
help : String
takesArg : FlagArg := .none
/-- Parsed flags from the command line. -/
structure ParsedFlags where
flags : Std.HashMap String (Option String) := {}
repeated : Std.HashMap String (Array String) := {}
namespace ParsedFlags
def getBool (pf : ParsedFlags) (name : String) : Bool :=
pf.flags.contains name
def getString (pf : ParsedFlags) (name : String) : Option String :=
match pf.flags[name]? with
| some (some v) => some v
| _ => Option.none
def getRepeated (pf : ParsedFlags) (name : String) : Array String :=
pf.repeated[name]?.getD #[]
def insertFlag (pf : ParsedFlags) (name : String) (value : Option String) : ParsedFlags :=
{ pf with flags := pf.flags.insert name value }
def insertRepeated (pf : ParsedFlags) (name : String) (value : String) : ParsedFlags :=
let arr := pf.repeated[name]?.getD #[]
{ pf with repeated := pf.repeated.insert name (arr.push value) }
def buildDialectFileMap (pflags : ParsedFlags) : IO Strata.DialectFileMap := do
let preloaded := Strata.Elab.LoadedDialects.builtin
|>.addDialect! Strata.Python.Python
|>.addDialect! Strata.Python.Specs.DDM.PythonSpecs
|>.addDialect! Strata.Core
|>.addDialect! Strata.Laurel.Laurel
|>.addDialect! Strata.smtReservedKeywordsDialect
|>.addDialect! Strata.SMTCore
|>.addDialect! Strata.SMT
|>.addDialect! Strata.SMTResponse
let mut sp ← Strata.DialectFileMap.new preloaded
for path in pflags.getRepeated "include" do
match ← sp.add path |>.toBaseIO with
| .error msg => exitFailure msg
| .ok sp' => sp := sp'
return sp
end ParsedFlags
def parseCheckMode (pflags : ParsedFlags) : IO VerificationMode :=
match pflags.getString "check-mode" with
| .none => pure .deductive
| .some s => match VerificationMode.ofString? s with
| .some m => pure m
| .none => exitFailure s!"Invalid check mode: '{s}'. Must be {VerificationMode.options}."
def parseCheckLevel (pflags : ParsedFlags) : IO CheckLevel :=
match pflags.getString "check-level" with
| .none => pure .minimal
| .some s => match CheckLevel.ofString? s with
| .some l => pure l
| .none => exitFailure s!"Invalid check level: '{s}'. Must be {CheckLevel.options}."
def checkModeFlag : Flag :=
{ name := "check-mode",
help := s!"Check mode: {VerificationMode.options}. Default: 'deductive'.",
takesArg := .arg "mode" }
def checkLevelFlag : Flag :=
{ name := "check-level",
help := s!"Check level: {CheckLevel.options}. Default: 'minimal'.",
takesArg := .arg "level" }
structure Command where
name : String
args : List String
flags : List Flag := []
help : String
callback : Vector String args.length → ParsedFlags → IO Unit
def includeFlag : Flag :=
{ name := "include", help := "Add a dialect search path.", takesArg := .repeat "path" }
def checkCommand : Command where
name := "check"
args := [ "file" ]
flags := [includeFlag]
help := "Parse and validate a Strata file (text or Ion). Reports errors and exits."
callback := fun v pflags => do
let fm ← pflags.buildDialectFileMap
let _ ← Strata.readStrataFile fm v[0]
def toIonCommand : Command where
name := "toIon"
args := [ "input", "output" ]
flags := [includeFlag]
help := "Convert a Strata text file to Ion binary format."
callback := fun v pflags => do
let searchPath ← pflags.buildDialectFileMap
let pd ← Strata.readStrataFile searchPath v[0]
match pd with
| .dialect d =>
IO.FS.writeBinFile v[1] d.toIon
| .program pgm =>
IO.FS.writeBinFile v[1] pgm.toIon
def printCommand : Command where
name := "print"
args := [ "file" ]
flags := [includeFlag]
help := "Pretty-print a Strata file (text or Ion) to stdout."
callback := fun v pflags => do
let searchPath ← pflags.buildDialectFileMap
-- Special case for already loaded dialects.
let ld ← searchPath.getLoaded
if mem : v[0] ∈ ld.dialects then
IO.print <| ld.dialects.format v[0] mem
return
let pd ← Strata.readStrataFile searchPath v[0]
match pd with
| .dialect d =>
let ld ← searchPath.getLoaded
let .isTrue mem := inferInstanceAs (Decidable (d.name ∈ ld.dialects))
| exitFailure "Internal error reading file."
IO.print <| ld.dialects.format d.name mem
| .program pgm =>
IO.print <| toString pgm
def diffCommand : Command where
name := "diff"
args := [ "file1", "file2" ]
flags := [includeFlag]
help := "Compare two program files for syntactic equality. Reports the first difference found."
callback := fun v pflags => do
let fm ← pflags.buildDialectFileMap
let p1 ← Strata.readStrataFile fm v[0]
let p2 ← Strata.readStrataFile fm v[1]
match p1, p2 with
| .program p1, .program p2 =>
if p1.dialect != p2.dialect then
exitFailure s!"Dialects differ: {p1.dialect} and {p2.dialect}"
let Decidable.isTrue eq := inferInstanceAs (Decidable (p1.commands.size = p2.commands.size))
| exitFailure s!"Number of commands differ {p1.commands.size} and {p2.commands.size}"
for (c1, c2) in Array.zip p1.commands p2.commands do
if c1 != c2 then
exitFailure s!"Commands differ: {repr c1} and {repr c2}"
| _, _ =>
exitFailure "Cannot compare dialect def with another dialect/program."
def readPythonStrata (strataPath : String) : IO Strata.Program := do
let bytes ← Strata.Util.readBinInputSource strataPath
if ! Ion.isIonFile bytes then
exitFailure s!"pyAnalyze expected Ion file"
match Strata.Program.fromIon Strata.Python.Python_map Strata.Python.Python.name bytes with
| .ok pgm => pure pgm
| .error msg => exitFailure msg
def pySpecsCommand : Command where
name := "pySpecs"
args := [ "python_path", "strata_path" ]
flags := [
{ name := "quiet", help := "Suppress default logging." },
{ name := "log", help := "Enable logging for an event type.",
takesArg := .repeat "event" },
{ name := "skip",
help := "Skip a top-level definition (module.name). Overloads are kept.",
takesArg := .repeat "name" }
]
help := "Translate a Python specification (.py) file into Strata DDM Ion format. Creates the output directory if needed. (Experimental)"
callback := fun v pflags => do
let quiet := pflags.getBool "quiet"
let mut events : Std.HashSet String := {}
if !quiet then
events := events.insert "import"
for e in pflags.getRepeated "log" do
events := events.insert e
let skipNames := pflags.getRepeated "skip"
let warningOutput : Strata.WarningOutput :=
if quiet then .none else .detail
-- Serialize embedded dialect for Python subprocess
IO.FS.withTempFile fun _handle dialectFile => do
IO.FS.writeBinFile dialectFile Strata.Python.Python.toIon
let r ← Strata.pySpecs (events := events)
(skipNames := skipNames)
(warningOutput := warningOutput)
v[0] v[1] dialectFile |>.toBaseIO
match r with
| .ok () => pure ()
| .error msg => exitFailure msg
def pyTranslateCommand : Command where
name := "pyTranslate"
args := [ "file" ]
help := "Translate a Python Ion program to Core and print the result to stdout."
callback := fun v _ => do
let pgm ← readPythonStrata v[0]
let preludePgm := Strata.Python.Core.prelude
let bpgm := Strata.pythonToCore Strata.Python.coreSignatures pgm preludePgm
let newPgm : Core.Program := { decls := preludePgm.decls ++ bpgm.decls }
IO.print newPgm
/-- Derive Python source file path from Ion file path.
E.g., "tests/test_foo.python.st.ion" -> "tests/test_foo.py" -/
def ionPathToPythonPath (ionPath : String) : Option String :=
if ionPath.endsWith ".python.st.ion" then
let basePath := ionPath.dropEnd ".python.st.ion".length |>.toString
some (basePath ++ ".py")
else if ionPath.endsWith ".py.ion" then
some (ionPath.dropEnd ".ion".length |>.toString)
else
none
/-- Try to read Python source file for source location reconstruction -/
def tryReadPythonSource (ionPath : String) : IO (Option (String × String)) := do
match ionPathToPythonPath ionPath with
| none => return none
| some pyPath =>
try
let content ← IO.FS.readFile pyPath
return some (pyPath, content)
catch _ =>
return none
def pyAnalyzeCommand : Command where
name := "pyAnalyze"
args := [ "file" ]
flags := [{ name := "verbose", help := "Enable verbose output." },
{ name := "sarif", help := "Write results as SARIF to <file>.sarif." }]
help := "Verify a Python Ion program. Translates to Core, inlines procedures, and runs SMT verification."
callback := fun v pflags => do
let verbose := pflags.getBool "verbose"
let outputSarif := pflags.getBool "sarif"
let filePath := v[0]
let pgm ← readPythonStrata filePath
-- Try to read the Python source for line number conversion
let pySourceOpt ← tryReadPythonSource filePath
if verbose then
IO.print pgm
let preludePgm := Strata.Python.Core.prelude
-- Use the Python source path if available, otherwise fall back to Ion path
let sourcePathForMetadata := match pySourceOpt with
| some (pyPath, _) => pyPath
| none => filePath
let bpgm := Strata.pythonToCore Strata.Python.coreSignatures pgm preludePgm sourcePathForMetadata
let newPgm : Core.Program := { decls := preludePgm.decls ++ bpgm.decls }
if verbose then
IO.print newPgm
match Core.Transform.runProgram (targetProcList := .none)
(Core.ProcedureInlining.inlineCallCmd
(doInline := λ name _ => name ≠ "main"))
newPgm .emp with
| ⟨.error e, _⟩ => panic! e
| ⟨.ok (_changed, newPgm), _⟩ =>
if verbose then
IO.println "Inlined: "
IO.print newPgm
let solverName : String := "Strata/Languages/Python/z3_parallel.py"
let verboseMode := VerboseMode.ofBool verbose
let options :=
{ VerifyOptions.default with
stopOnFirstError := false,
verbose := verboseMode,
removeIrrelevantAxioms := true,
solver := solverName }
let runVerification tempDir :=
EIO.toIO
(fun f => IO.Error.userError (toString f))
(Core.verify newPgm tempDir .none options
(moreFns := Strata.Python.ReFactory))
let vcResults ← match options.vcDirectory with
| .none => IO.FS.withTempDir runVerification
| .some tempDir => runVerification tempDir
let mfm : Option (String × Lean.FileMap) := match pySourceOpt with
| some (pyPath, srcText) => some (pyPath, .ofString srcText)
| none => none
let mut s := ""
for vcResult in vcResults do
-- Build location string based on available metadata
let (locationPrefix, locationSuffix) := match Imperative.getFileRange vcResult.obligation.metadata with
| some fr =>
if fr.range.isNone then ("", "")
else
match mfm with
| some (pyPath, fm) =>
-- Check if this metadata is from the Python source (not CorePrelude)
match fr.file with
| .file path =>
if path == pyPath then
let pos := fm.toPosition fr.range.start
-- For failures, show at beginning; for passes, show at end
if vcResult.isFailure then
(s!"Assertion failed at line {pos.line}, col {pos.column}: ", "")
else
("", s!" (at line {pos.line}, col {pos.column})")
else
-- From CorePrelude or other source, show byte offsets
if vcResult.isFailure then
(s!"Assertion failed for prelude: ", "")
else
("", s!" (in prelude)")
| none =>
if vcResult.isFailure then
(s!"Assertion failed at byte offset: ", "")
else
("", s!" (at byte offset)")
| none => ("", "")
let outcomeStr := vcResult.formatOutcome
s := s ++ s!"\n{locationPrefix}{vcResult.obligation.label}: \
{outcomeStr}{locationSuffix}\n"
IO.println s
-- Output in SARIF format if requested
if outputSarif then
let files := match mfm with
| some (pyPath, fm) => Map.empty.insert (Strata.Uri.file pyPath) fm
| none => Map.empty
Core.Sarif.writeSarifOutput .deductive files vcResults (filePath ++ ".sarif")
def pyAnalyzeLaurelCommand : Command where
name := "pyAnalyzeLaurel"
args := [ "file" ]
flags := [{ name := "verbose", help := "Enable verbose output." },
{ name := "pyspec",
help := "Add PySpec-derived Laurel declarations.",
takesArg := .repeat "ion_file" },
{ name := "dispatch",
help := "Extract overload dispatch table from a \
PySpec Ion file (no Laurel translation).",
takesArg := .repeat "ion_file" },
{ name := "sarif", help := "Write results as SARIF to <file>.sarif." },
{ name := "vc-directory",
help := "Store VCs in SMT-Lib format in <dir>.",
takesArg := .arg "dir" },
checkModeFlag, checkLevelFlag]
help := "Verify a Python Ion program via the Laurel pipeline. Translates Python to Laurel to Core, then runs SMT verification."
callback := fun v pflags => do
let verbose := pflags.getBool "verbose"
let outputSarif := pflags.getBool "sarif"
let filePath := v[0]
let pySourceOpt ← tryReadPythonSource filePath
if verbose then
let pgm ← readPythonStrata filePath
IO.println "==== Python AST ===="
IO.print pgm
let dispatchFiles := pflags.getRepeated "dispatch"
let pyspecFiles := pflags.getRepeated "pyspec"
let sourcePath := pySourceOpt.map (·.1)
-- Build FileMap for source position resolution.
let mfm : Option (String × Lean.FileMap) := match pySourceOpt with
| some (pyPath, srcText) => some (pyPath, .ofString srcText)
| none => none
let combinedLaurel ←
match ← Strata.pyAnalyzeLaurel filePath dispatchFiles pyspecFiles sourcePath |>.toBaseIO with
| .ok r => pure r
| .error (.userCode range msg) =>
let location := if range.isNone then "" else
match mfm with
| some (_, fm) =>
let pos := fm.toPosition range.start
s!" at line {pos.line}, col {pos.column}"
| none => ""
exitUserCodeError s!"{msg}{location}"
| .error (.internal msg) => exitInternalError msg
if verbose then
IO.println "\n==== Laurel Program ===="
IO.println f!"{combinedLaurel}"
let (coreProgramOption, laurelTranslateErrors) := Strata.translateCombinedLaurel combinedLaurel
let coreProgram ←
match coreProgramOption with
| none =>
exitInternalError s!"Laurel to Core translation failed: {laurelTranslateErrors}"
| some core => pure core
if verbose then
IO.println "\n==== Core Program ===="
IO.print coreProgram
-- Verify using Core verifier
let checkMode ← parseCheckMode pflags
let checkLevel ← parseCheckLevel pflags
let baseOptions : VerifyOptions :=
{ VerifyOptions.default with
stopOnFirstError := false, verbose := .quiet, solver := "z3",
checkMode := checkMode, checkLevel := checkLevel }
let options : VerifyOptions := match pflags.getString "vc-directory" with
| .some dir => { baseOptions with vcDirectory := some (dir : System.FilePath) }
| .none => baseOptions
let vcResults ←
match ← Strata.verifyCore coreProgram options |>.toBaseIO with
| .ok r => pure r
| .error msg => exitInternalError msg
-- Print results
if !laurelTranslateErrors.isEmpty then
IO.println "\n==== Errors ===="
for err in laurelTranslateErrors do
IO.println err
-- Print results
IO.println "\n==== Verification Results ===="
let mut s := ""
for vcResult in vcResults do
let (locationPrefix, locationSuffix) := match Imperative.getFileRange vcResult.obligation.metadata with
| some fr =>
if fr.range.isNone then ("", "")
else
match mfm with
| some (_, fm) =>
match fr.file with
| .file "" =>
if vcResult.isFailure then
(s!"Assertion failed in prelude file: ", "")
else
("", s!" (in prelude file)")
| .file path =>
let pos := fm.toPosition fr.range.start
if vcResult.isFailure then
(s!"Assertion failed at line {pos.line}, col {pos.column}: ", "")
else
("", s!" (at line {pos.line}, col {pos.column})")
| none =>
if vcResult.isFailure then
(s!"Assertion failed: ", "")
else
("", "")
| none => ("", "")
let outcomeStr := vcResult.formatOutcome
s := s ++ s!"{locationPrefix}{vcResult.obligation.label}: \
{outcomeStr}{locationSuffix}\n"
IO.println s
-- Output in SARIF format if requested
if outputSarif then
let files := match mfm with
| some (pyPath, fm) => Map.empty.insert (Strata.Uri.file pyPath) fm
| none => Map.empty
Core.Sarif.writeSarifOutput checkMode files vcResults (filePath ++ ".sarif")
private def deriveBaseName (file : String) : String :=
let name := System.FilePath.fileName file |>.getD file
if name.endsWith ".python.st.ion" then (name.dropEnd 14).toString
else if name.endsWith ".py.ion" then (name.dropEnd 7).toString
else if name.endsWith ".st.ion" then (name.dropEnd 7).toString
else if name.endsWith ".st" then (name.dropEnd 3).toString
else name
def pyAnalyzeToGotoCommand : Command where
name := "pyAnalyzeToGoto"
args := [ "file" ]
help := "Translate a Strata Python Ion file to CProver GOTO JSON files."
callback := fun v _ => do
let filePath := v[0]
let pgm ← readPythonStrata filePath
let pySourceOpt ← tryReadPythonSource filePath
let preludePgm := Strata.Python.Core.prelude
let sourcePathForMetadata := match pySourceOpt with
| some (pyPath, _) => pyPath
| none => filePath
let bpgm := Strata.pythonToCore Strata.Python.coreSignatures pgm preludePgm sourcePathForMetadata
let sourceText := pySourceOpt.map (·.2)
let newPgm : Core.Program := { decls := preludePgm.decls ++ bpgm.decls }
match Core.Transform.runProgram (targetProcList := .none)
(Core.ProcedureInlining.inlineCallCmd
(doInline := λ name _ => name ≠ "main"))
newPgm .emp with
| ⟨.error e, _⟩ => panic! e
| ⟨.ok (_changed, newPgm), _⟩ =>
-- Type-check the full program (registers Python types like ExceptOrNone)
let Ctx := { Lambda.LContext.default with functions := Core.Factory, knownTypes := Core.KnownTypes }
let Env := Lambda.TEnv.default
let (tcPgm, _) ← match Core.Program.typeCheck Ctx Env newPgm with
| .ok r => pure r
| .error e => panic! s!"{e.format none}"
-- Find the main procedure
let some mainDecl := tcPgm.decls.find? fun d =>
match d with
| .proc p _ => Core.CoreIdent.toPretty p.header.name == "main"
| _ => false
| panic! "No main procedure found"
let some p := mainDecl.getProc?
| panic! "main is not a procedure"
-- Translate procedure to GOTO (mirrors CoreToGOTO.transformToGoto post-typecheck logic)
let baseName := deriveBaseName filePath
let procName := Core.CoreIdent.toPretty p.header.name
let axioms := tcPgm.decls.filterMap fun d => d.getAxiom?
let distincts := tcPgm.decls.filterMap fun d => match d with
| .distinct name es _ => some (name, es) | _ => none
match procedureToGotoCtx Env p sourceText (axioms := axioms) (distincts := distincts)
(varTypes := tcPgm.getVarTy?) with
| .error e => panic! s!"{e}"
| .ok (ctx, liftedFuncs) =>
let extraSyms ← match collectExtraSymbols tcPgm with
| .ok s => pure (Lean.toJson s)
| .error e => panic! s!"{e}"
let (symtab, goto) ← emitProcWithLifted Env procName ctx liftedFuncs extraSyms
(moduleName := baseName)
let symTabFile := s!"{baseName}.symtab.json"
let gotoFile := s!"{baseName}.goto.json"
IO.FS.writeFile symTabFile symtab.pretty
IO.FS.writeFile gotoFile goto.pretty
IO.println s!"Written {symTabFile} and {gotoFile}"
def pyTranslateLaurelCommand : Command where
name := "pyTranslateLaurel"
args := [ "file" ]
flags := [{ name := "pyspec",
help := "Add PySpec-derived Laurel declarations.",
takesArg := .repeat "ion_file" },
{ name := "dispatch",
help := "Extract overload dispatch table from a \
PySpec Ion file (no Laurel translation).",
takesArg := .repeat "ion_file" }]
help := "Translate a Strata Python Ion file through Laurel to Strata Core. Write results to stdout."
callback := fun v pflags => do
let dispatchFiles := pflags.getRepeated "dispatch"
let pyspecFiles := pflags.getRepeated "pyspec"
let coreProgram ←
match ← Strata.pyTranslateLaurel v[0] dispatchFiles pyspecFiles |>.toBaseIO with
| .ok r => pure r
| .error msg => exitFailure msg
IO.print coreProgram
def pyAnalyzeLaurelToGotoCommand : Command where
name := "pyAnalyzeLaurelToGoto"
args := [ "file" ]
flags := [{ name := "pyspec",
help := "Add PySpec-derived Laurel declarations.",
takesArg := .repeat "ion_file" },
{ name := "dispatch",
help := "Extract overload dispatch table from a \
PySpec Ion file (no Laurel translation).",
takesArg := .repeat "ion_file" }]
help := "Translate a Strata Python Ion file through Laurel to CProver GOTO JSON files."
callback := fun v pflags => do
let filePath := v[0]
let dispatchFiles := pflags.getRepeated "dispatch"
let pyspecFiles := pflags.getRepeated "pyspec"
let (coreProgram, laurelTranslateErrors) ←
match ← Strata.pyTranslateLaurel filePath dispatchFiles pyspecFiles |>.toBaseIO with
| .ok r => pure r
| .error msg => exitFailure msg
let sourceText := (← tryReadPythonSource filePath).map (·.2)
let baseName := deriveBaseName filePath
match ← Strata.inlineCoreToGotoFiles coreProgram baseName sourceText |>.toBaseIO with
| .ok () => pure ()
| .error msg => exitFailure msg
def javaGenCommand : Command where
name := "javaGen"
args := [ "dialect", "package", "output-dir" ]
flags := [includeFlag]
help := "Generate Java source files from a DDM dialect definition. Accepts a dialect name (e.g. Laurel) or a dialect file path."
callback := fun v pflags => do
let fm ← pflags.buildDialectFileMap
let ld ← fm.getLoaded
let d ← if mem : v[0] ∈ ld.dialects then
pure ld.dialects[v[0]]
else
match ← Strata.readStrataFile fm v[0] with
| .dialect d => pure d
| .program _ => exitFailure "Expected a dialect file, not a program file."
match Strata.Java.generateDialect d v[1] with
| .ok files =>
Strata.Java.writeJavaFiles v[2] v[1] files
IO.println s!"Generated Java files for {d.name} in {v[2]}/{Strata.Java.packageToPath v[1]}"
| .error msg =>
exitFailure s!"Error generating Java: {msg}"
def laurelVerifyOptions : VerifyOptions := { VerifyOptions.default with solver := "z3" }
def deserializeIonToLaurelFiles (bytes : ByteArray) : IO (List Strata.StrataFile) := do
match Strata.Program.filesFromIon Strata.Laurel.Laurel_map bytes with
| .ok files => pure files
| .error msg => exitFailure msg
def laurelAnalyzeBinaryCommand : Command where
name := "laurelAnalyzeBinary"
args := []
help := "Verify Laurel Ion programs read from stdin and print diagnostics. Combines multiple input files."
callback := fun _ _ => do
-- Read bytes from stdin
let stdinBytes ← (← IO.getStdin).readBinToEnd
let strataFiles ← deserializeIonToLaurelFiles stdinBytes
let mut combinedProgram : Strata.Laurel.Program := {
staticProcedures := []
staticFields := []
types := []
}
for strataFile in strataFiles do
let transResult := Strata.Laurel.TransM.run (Strata.Uri.file strataFile.filePath) (Strata.Laurel.parseProgram strataFile.program)
match transResult with
| .error transErrors => exitFailure s!"Translation errors in {strataFile.filePath}: {transErrors}"
| .ok laurelProgram =>
combinedProgram := {
staticProcedures := combinedProgram.staticProcedures ++ laurelProgram.staticProcedures
staticFields := combinedProgram.staticFields ++ laurelProgram.staticFields
types := combinedProgram.types ++ laurelProgram.types
}
let diagnostics ← Strata.Laurel.verifyToDiagnosticModels combinedProgram laurelVerifyOptions
IO.println s!"==== DIAGNOSTICS ===="
for diag in diagnostics do
IO.println s!"{Std.format diag.fileRange.file}:{diag.fileRange.range.start}-{diag.fileRange.range.stop}: {diag.message}"
def pySpecToLaurelCommand : Command where
name := "pySpecToLaurel"
args := [ "python_path", "strata_path" ]
help := "Translate a PySpec Ion file to Laurel declarations. The Ion file must already exist."
callback := fun v _ => do
let pythonFile : System.FilePath := v[0]
let strataDir : System.FilePath := v[1]
let some mod := pythonFile.fileStem
| exitFailure s!"No stem {pythonFile}"
let .ok mod := Strata.Python.Specs.ModuleName.ofString mod
| exitFailure s!"Invalid module {mod}"
let ionFile := strataDir / mod.strataFileName
let sigs ←
match ← Strata.Python.Specs.readDDM ionFile |>.toBaseIO with
| .ok t => pure t
| .error msg => exitFailure s!"Could not read {ionFile}: {msg}"
let result := Strata.Python.Specs.ToLaurel.signaturesToLaurel pythonFile sigs
if result.errors.size > 0 then
IO.eprintln s!"{result.errors.size} translation warning(s):"
for err in result.errors do
IO.eprintln s!" {err.file}: {err.message}"
let pgm := result.program
IO.println s!"Laurel: {pgm.staticProcedures.length} procedure(s), {pgm.types.length} type(s)"
IO.println s!"Overloads: {result.overloads.size} function(s)"
for td in pgm.types do
IO.println s!" {Strata.Laurel.formatTypeDefinition td}"
for proc in pgm.staticProcedures do
IO.println s!" {Strata.Laurel.formatProcedure proc}"
def pyResolveOverloadsCommand : Command where
name := "pyResolveOverloads"
args := [ "python_path", "dispatch_ion" ]
help := "Identify which overloaded service modules a \
Python program uses. Prints one module name per \
line to stdout."
callback := fun v _ => do
let pythonFile : System.FilePath := v[0]
let dispatchPath := v[1]
-- Read dispatch overload table
let overloads ←
match ← readDispatchOverloads #[dispatchPath] |>.toBaseIO with
| .ok r => pure r
| .error msg => exitFailure msg
-- Convert .py to Python AST
let stmts ←
IO.FS.withTempFile fun _handle dialectFile => do
IO.FS.writeBinFile dialectFile
Strata.Python.Python.toIon
match ← Strata.Python.pythonToStrata dialectFile pythonFile |>.toBaseIO with
| .ok s => pure s
| .error msg => exitFailure msg
-- Walk AST and collect modules
let state :=
Strata.Python.Specs.IdentifyOverloads.resolveOverloads
overloads stmts
for w in state.warnings do
IO.eprintln s!"warning: {w}"
let sorted := state.modules.toArray.qsort (· < ·)
for m in sorted do
IO.println m
def laurelParseCommand : Command where
name := "laurelParse"
args := [ "file" ]
help := "Parse a Laurel source file (no verification)."
callback := fun v _ => do
let path : System.FilePath := v[0]
let content ← IO.FS.readFile path
let input := Strata.Parser.stringInputContext path content
let dialects := Strata.Elab.LoadedDialects.ofDialects! #[Strata.initDialect, Strata.Laurel.Laurel]
let strataProgram ← Strata.Elab.parseStrataProgramFromDialect dialects Strata.Laurel.Laurel.name input
let uri := Strata.Uri.file path.toString
let transResult := Strata.Laurel.TransM.run uri (Strata.Laurel.parseProgram strataProgram)
match transResult with
| .error transErrors => exitFailure s!"Translation errors: {transErrors}"
| .ok _ => IO.println "Parse successful"
def laurelAnalyzeCommand : Command where
name := "laurelAnalyze"
args := [ "file" ]
help := "Analyze a Laurel source file. Write diagnostics to stdout."
callback := fun v _ => do
let path : System.FilePath := v[0]
let content ← IO.FS.readFile path
let input := Strata.Parser.stringInputContext path content
let dialects := Strata.Elab.LoadedDialects.ofDialects! #[Strata.initDialect, Strata.Laurel.Laurel]
let strataProgram ← Strata.Elab.parseStrataProgramFromDialect dialects Strata.Laurel.Laurel.name input
let uri := Strata.Uri.file path.toString
let transResult := Strata.Laurel.TransM.run uri (Strata.Laurel.parseProgram strataProgram)
match transResult with
| .error transErrors => exitFailure s!"Translation errors: {transErrors}"
| .ok laurelProgram =>
let (vcResultsOption, errors) ← Strata.Laurel.verifyToVcResults laurelProgram { VerifyOptions.default with solver := "z3" }
if !errors.isEmpty then
IO.println s!"==== ERRORS ===="
for err in errors do
IO.println s!"{err.message}"
match vcResultsOption with
| none => return
| some vcResults =>
IO.println s!"==== RESULTS ===="
for vc in vcResults do
IO.println s!"{vc.obligation.label}: {match vc.outcome with | .ok o => repr o | .error e => e}"
def laurelAnalyzeToGotoCommand : Command where
name := "laurelAnalyzeToGoto"
args := [ "file" ]
help := "Translate a Laurel source file to CProver GOTO JSON files."
callback := fun v _ => do
let path : System.FilePath := v[0]
let content ← IO.FS.readFile path
let input := Strata.Parser.stringInputContext path content
let dialects := Strata.Elab.LoadedDialects.ofDialects! #[Strata.initDialect, Strata.Laurel.Laurel]
let strataProgram ← Strata.Elab.parseStrataProgramFromDialect dialects Strata.Laurel.Laurel.name input
let uri := Strata.Uri.file path.toString
let transResult := Strata.Laurel.TransM.run uri (Strata.Laurel.parseProgram strataProgram)
match transResult with
| .error transErrors => exitFailure s!"Translation errors: {transErrors}"
| .ok laurelProgram =>
match Strata.Laurel.translate {} laurelProgram with
| (none, diags) => exitFailure s!"Core translation errors: {diags.map (·.message)}"
| (some coreProgram, errors) =>
let Ctx := { Lambda.LContext.default with functions := Core.Factory, knownTypes := Core.KnownTypes }
let Env := Lambda.TEnv.default
let (tcPgm, _) ← match Core.Program.typeCheck Ctx Env coreProgram with
| .ok r => pure r
| .error e => panic! s!"{e.format none}"
let procs := tcPgm.decls.filterMap fun d => d.getProc?
let funcs := tcPgm.decls.filterMap fun d =>
match d.getFunc? with
| some f =>
let name := Core.CoreIdent.toPretty f.name
if f.body.isSome && f.typeArgs.isEmpty
&& name != "Int.DivT" && name != "Int.ModT"
then some f else none
| none => none
if procs.isEmpty && funcs.isEmpty then panic! "No procedures or functions found"
let baseName := deriveBaseName path.toString
let typeSyms ← match collectExtraSymbols tcPgm with
| .ok s => pure s
| .error e => panic! s!"{e}"
let typeSymsJson := Lean.toJson typeSyms
let sourceText := some content
let axioms := tcPgm.decls.filterMap fun d => d.getAxiom?
let distincts := tcPgm.decls.filterMap fun d => match d with
| .distinct name es _ => some (name, es) | _ => none
let mut symtabPairs : List (String × Lean.Json) := []
let mut gotoFns : Array Lean.Json := #[]
let mut allLiftedFuncs : List Core.Function := []
for p in procs do
let procName := Core.CoreIdent.toPretty p.header.name
match procedureToGotoCtx Env p (sourceText := sourceText) (axioms := axioms) (distincts := distincts)
(varTypes := tcPgm.getVarTy?) with
| .error e => panic! s!"{e}"
| .ok (ctx, liftedFuncs) =>
allLiftedFuncs := allLiftedFuncs ++ liftedFuncs
let json ← IO.ofExcept (CoreToGOTO.CProverGOTO.Context.toJson procName ctx)
match json.symtab with
| .obj m => symtabPairs := symtabPairs ++ m.toList
| _ => pure ()
match json.goto with
| .obj m =>
match m.toList.find? (·.1 == "functions") with
| some (_, .arr fns) => gotoFns := gotoFns ++ fns
| _ => pure ()
| _ => pure ()
for f in funcs ++ allLiftedFuncs do
let funcName := Core.CoreIdent.toPretty f.name
match functionToGotoCtx Env f with
| .error e => panic! s!"{e}"
| .ok ctx =>
let json ← IO.ofExcept (CoreToGOTO.CProverGOTO.Context.toJson funcName ctx)
match json.symtab with
| .obj m => symtabPairs := symtabPairs ++ m.toList
| _ => pure ()
match json.goto with
| .obj m =>
match m.toList.find? (·.1 == "functions") with
| some (_, .arr fns) => gotoFns := gotoFns ++ fns
| _ => pure ()
| _ => pure ()
match typeSymsJson with
| .obj m => symtabPairs := symtabPairs ++ m.toList
| _ => pure ()
-- Deduplicate: keep first occurrence of each symbol name (proper function
-- symbols come before basic symbol references from callers)
let mut seen : Std.HashSet String := {}
let mut dedupPairs : List (String × Lean.Json) := []
for (k, v) in symtabPairs do
if !seen.contains k then
seen := seen.insert k
dedupPairs := dedupPairs ++ [(k, v)]
-- Add CBMC default symbols (architecture constants, builtins)
-- and wrap in {"symbolTable": ...} for symtab2gb
let symtabObj := dedupPairs.foldl
(fun (acc : Std.TreeMap.Raw String Lean.Json) (k, v) => acc.insert k v)
.empty
let symtab := CProverGOTO.wrapSymtab symtabObj (moduleName := baseName)
let goto := Lean.Json.mkObj [("functions", Lean.Json.arr gotoFns)]
let symTabFile := s!"{baseName}.symtab.json"
let gotoFile := s!"{baseName}.goto.json"
IO.FS.writeFile symTabFile symtab.pretty
IO.FS.writeFile gotoFile goto.pretty
IO.println s!"Written {symTabFile} and {gotoFile}"
def laurelPrintCommand : Command where
name := "laurelPrint"
args := []
help := "Read Laurel Ion from stdin and print in concrete syntax to stdout."
callback := fun _ _ => do
let stdinBytes ← (← IO.getStdin).readBinToEnd
let strataFiles ← deserializeIonToLaurelFiles stdinBytes
for strataFile in strataFiles do
IO.println s!"// File: {strataFile.filePath}"
let p := strataFile.program
let c := p.formatContext {}
let s := p.formatState
let fmt := p.commands.foldl (init := f!"") fun f cmd =>
f ++ (Strata.mformat cmd c s).format
IO.println (fmt.pretty 100)
IO.println ""
def prettyPrintCore (p : Core.Program) : String :=
let decls := p.decls.map fun d =>
let s := toString (Std.format d)
-- Add newlines after major sections in procedures
s.replace "preconditions:" "\n preconditions:"
|>.replace "postconditions:" "\n postconditions:"
|>.replace "body:" "\n body:\n "
|>.replace "assert [" "\n assert ["
|>.replace "init (" "\n init ("
|>.replace "while (" "\n while ("
|>.replace "if (" "\n if ("
|>.replace "call [" "\n call ["
|>.replace "else{" "\n else {"
|>.replace "}}" "}\n }"
String.intercalate "\n" decls
def laurelToCoreCommand : Command where
name := "laurelToCore"
args := [ "file" ]
help := "Translate a Laurel source file to Core and print to stdout."
callback := fun v _ => do
let path : System.FilePath := v[0]
let content ← IO.FS.readFile path
let input := Strata.Parser.stringInputContext path content
let dialects := Strata.Elab.LoadedDialects.ofDialects! #[Strata.initDialect, Strata.Laurel.Laurel]
let strataProgram ← Strata.Elab.parseStrataProgramFromDialect dialects Strata.Laurel.Laurel.name input
let uri := Strata.Uri.file path.toString
let transResult := Strata.Laurel.TransM.run uri (Strata.Laurel.parseProgram strataProgram)
match transResult with
| .error transErrors => exitFailure s!"Translation errors: {transErrors}"
| .ok laurelProgram =>
let (coreProgramOption, errors) := Strata.Laurel.translate {} laurelProgram
if !errors.isEmpty then
IO.println s!"Core translation errors: {errors.map (·.message)}"
match coreProgramOption with
| none => return
| some coreProgram => IO.println (prettyPrintCore coreProgram)
/-- Print a string word-wrapped to `width` columns with `indent` spaces of indentation. -/
private def printIndented (indent : Nat) (s : String) (width : Nat := 80) : IO Unit := do
let pad := "".pushn ' ' indent
let words := s.splitOn " " |>.filter (!·.isEmpty)
let mut line := pad
let mut first := true
for word in words do
if first then
line := line ++ word
first := false
else if line.length + 1 + word.length > width then
IO.println line
line := pad ++ word
else
line := line ++ " " ++ word
unless line.length ≤ indent do
IO.println line
structure CommandGroup where
name : String
commands : List Command
commonFlags : List Flag := []
def commandGroups : List CommandGroup := [
{ name := "Core"
commands := [checkCommand, toIonCommand, printCommand, diffCommand]
commonFlags := [includeFlag] },
{ name := "Code Generation"
commands := [javaGenCommand] },
{ name := "Python"
commands := [pyAnalyzeCommand, pyAnalyzeLaurelCommand,
pyResolveOverloadsCommand,
pySpecsCommand, pySpecToLaurelCommand,
pyAnalyzeLaurelToGotoCommand,
pyAnalyzeToGotoCommand,
pyTranslateCommand,
pyTranslateLaurelCommand] },
{ name := "Laurel"
commands := [laurelAnalyzeCommand, laurelAnalyzeBinaryCommand,
laurelAnalyzeToGotoCommand, laurelParseCommand,
laurelPrintCommand, laurelToCoreCommand] },
]
def commandList : List Command :=
commandGroups.foldl (init := []) fun acc g => acc ++ g.commands
def commandMap : Std.HashMap String Command :=
commandList.foldl (init := {}) fun m c => m.insert c.name c
/-- Print a single flag's name and help text at the given indentation. -/
private def printFlag (indent : Nat) (flag : Flag) : IO Unit := do
let pad := "".pushn ' ' indent
match flag.takesArg with
| .arg argName | .repeat argName =>
IO.println s!"{pad}--{flag.name} <{argName}> {flag.help}"
| .none =>
IO.println s!"{pad}--{flag.name} {flag.help}"
/-- Print help for all command groups. -/
private def printGlobalHelp : IO Unit := do
IO.println "Usage: strata <command> [flags]...\n"
IO.println "Command-line utilities for working with Strata.\n"
for group in commandGroups do
IO.println s!"{group.name}:"
for cmd in group.commands do
let cmdLine := cmd.args.foldl (init := cmd.name) fun s a => s!"{s} <{a}>"
IO.println s!" {cmdLine}"